 |
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
Verfasst am: 10.08.2015, 08:17 Titel: Kompression |
|
|
Hallo liebes Forum. ': Ich mach da gerade etwas mir der Datenkompression rum , das Decodieren klappt so aber nicht ganz korrekt. Weiss nicht, woran das liegt. Hab wohl mal wieder Tomaten auf den Augen. Auch kommt man so nur auf max. 30% Kompression. Wäre froh, wenn mir da jemand weiterhelfen könnte. Vielen Dank!! ';
Code: |
dim as integer i
dim as string text
for i=174 to 205
if instr(text,chr(i))>0 then end
next
open "Finden.txt" for binary access read as #1
text=input(lof(1),#1)
close
i=0
open "Text.txt" for output as #1
do
if text[i]=asc("e") and text[i+1]=asc("n") _
and text[i+2]=asc(" ")then print #1,chr(174);:i+=3
if text[i]=asc("e") and text[i+1]=asc("r") _
and text[i+2]=asc(" ")then print #1,chr(175);:i+=3
if text[i]=asc("n") and text[i+1]=asc("d") _
and text[i+2]=asc(" ")then print #1,chr(176);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("d") _
and text[i+2]=asc("e")then print #1,chr(177);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("u") _
and text[i+2]=asc("n")then print #1,chr(178);:i+=3
if text[i]=asc("u") and text[i+1]=asc("n") _
and text[i+2]=asc("d")then print #1,chr(179);:i+=3
if text[i]=asc("e") and text[i+1]=asc("i") _
and text[i+2]=asc("n")then print #1,chr(180);:i+=3
if text[i]=asc("d") and text[i+1]=asc("e") _
and text[i+2]=asc("r")then print #1,chr(181);:i+=3
if text[i]=asc("i") and text[i+1]=asc("e") _
and text[i+2]=asc(" ")then print #1,chr(182);:i+=3
if text[i]=asc("c") and text[i+1]=asc("h") _
and text[i+2]=asc(" ")then print #1,chr(183);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("d") _
and text[i+2]=asc("a")then print #1,chr(184);:i+=3
if text[i]=asc("i") and text[i+1]=asc("c") _
and text[i+2]=asc("h")then print #1,chr(185);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("d") _
and text[i+2]=asc("i")then print #1,chr(186);:i+=3
if text[i]=asc("i") and text[i+1]=asc("n") _
and text[i+2]=asc(" ")then print #1,chr(187);:i+=3
if text[i]=asc("i") and text[i+1]=asc("n") _
and text[i+2]=asc("e")then print #1,chr(188);:i+=3
if text[i]=asc("e") and text[i+1]=asc("s") _
and text[i+2]=asc(" ")then print #1,chr(189);:i+=3
if text[i]=asc("d") and text[i+1]=asc("a") _
and text[i+2]=asc("s")then print #1,chr(190);:i+=3
if text[i]=asc("d") and text[i+1]=asc("i") _
and text[i+2]=asc("e")then print #1,chr(191);:i+=3
if text[i]=asc("d") and text[i+1]=asc("e") _
and text[i+2]=asc("n")then print #1,chr(192);:i+=3
if text[i]=asc("c") and text[i+1]=asc("h") _
and text[i+2]=asc("t")then print #1,chr(193);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("i") _
and text[i+2]=asc("h")then print #1,chr(194);:i+=3
if text[i]=asc("n") and text[i+1]=asc(" ") _
and text[i+2]=asc("d")then print #1,chr(195);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("s") _
and text[i+2]=asc("i")then print #1,chr(196);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("g") _
and text[i+2]=asc("e")then print #1,chr(197);:i+=3
if text[i]=asc("e") and text[i+1]=asc("m") _
and text[i+2]=asc(" ")then print #1,chr(198);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("s") _
and text[i+2]=asc("e")then print #1,chr(199);:i+=3
if text[i]=asc("a") and text[i+1]=asc("c") _
and text[i+2]=asc("h")then print #1,chr(200);:i+=3
if text[i]=asc("t") and text[i+1]=asc("e") _
and text[i+2]=asc("r")then print #1,chr(201);:i+=3
if text[i]=asc("t") and text[i+1]=asc("e") _
and text[i+2]=asc("n")then print #1,chr(202);:i+=3
if text[i]=asc("n") and text[i+1]=asc("d") _
and text[i+2]=asc("e")then print #1,chr(203);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("z") _
and text[i+2]=asc("u")then print #1,chr(204);:i+=3
if text[i]=asc(" ") and text[i+1]=asc("s") _
and text[i+2]=asc("o")then print #1,chr(205);:i+=3
print #1,chr(text[i]);:i+=1
loop until i=len(text)-3
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);
close
open "Text.txt" for binary access read as #1
text=input(lof(1),#1)
close
i=0
open "Text2.txt" for output as #1
do
if text[i]=174 then print #1,"en ";:i+=1
if text[i]=175 then print #1,"er ";:i+=1
if text[i]=176 then print #1,"nd ";:i+=1
if text[i]=177 then print #1," de";:i+=1
if text[i]=178 then print #1," un";:i+=1
if text[i]=179 then print #1,"und";:i+=1
if text[i]=180 then print #1,"ein";:i+=1
if text[i]=181 then print #1,"der";:i+=1
if text[i]=182 then print #1,"ie ";:i+=1
if text[i]=183 then print #1,"ch ";:i+=1
if text[i]=184 then print #1," da";:i+=1
if text[i]=185 then print #1,"ich";:i+=1
if text[i]=186 then print #1," di";:i+=1
if text[i]=187 then print #1,"in ";:i+=1
if text[i]=188 then print #1,"ine";:i+=1
if text[i]=189 then print #1,"es ";:i+=1
if text[i]=190 then print #1,"das";:i+=1
if text[i]=191 then print #1,"die";:i+=1
if text[i]=192 then print #1,"den";:i+=1
if text[i]=193 then print #1,"cht";:i+=1
if text[i]=194 then print #1," ih";:i+=1
if text[i]=195 then print #1,"n d";:i+=1
if text[i]=196 then print #1," si";:i+=1
if text[i]=197 then print #1," ge";:i+=1
if text[i]=198 then print #1,"em ";:i+=1
if text[i]=199 then print #1," se";:i+=1
if text[i]=200 then print #1,"ach";:i+=1
if text[i]=201 then print #1,"ter";:i+=1
if text[i]=202 then print #1,"ten";:i+=1
if text[i]=203 then print #1,"nde";:i+=1
if text[i]=204 then print #1," zu";:i+=1
if text[i]=205 then print #1," so";:i+=1
print #1,chr(text[i]);:i+=1
loop until i>=len(text)-3
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);
close
end |
Zuletzt bearbeitet von Input am 10.08.2015, 12:22, insgesamt einmal bearbeitet |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4702 Wohnort: ~/
|
Verfasst am: 10.08.2015, 09:53 Titel: |
|
|
Funktioniert denn die Datenkompression? Zwei Anmerkungen auf die Schnelle:
Code: | if text[i]=asc("a") and text[i+1]=asc("c") _
and text[i+2]=asc("h")then print #1,chr(174);:i+=3 |
Dir ist klar, dass beim ersten Durchlauf i auf dem Wert 190 steht? (Und warum das so ist?)
Abgesehen davon, dass du am Anfang einen leeren String auf Codierungszeichen prüfst und anschließend etwas hineinlädst ...
Code: | loop until i=len(text) |
Bei den letzten beiden Durchläufen greifst du mit text[i+1] und text[i+2] auf unerlaubte Speicherbereiche zu. Wenn du am Ende des Textes was findest (z. B. wenn genau die letzten drei Zeichen "ach" sind), ist es sogar noch etwas schlimmer, weil du dann i um 3 erhöhst, aber vor Schleifenende noch weiterprüfst - also die nächsten drei Zeichen hinter Speicherende.
Komprimiere mal einen kurzen Text und lass dir den komprimierten String anzeigen (für Testzwecke würde ich als Codierungszeichen erst einmal die Ziffern 0-9 nehmen, weil es dann leichter zu debuggen ist), dann siehst du vielleicht schon, wo es hakt. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
Verfasst am: 10.08.2015, 12:21 Titel: |
|
|
Vielen Dank, hab's jetzt geschafft und das Programm entsprechend korrigiert. Die Kompression liegt jetzt bei legendären 20%. Würde das gerne bei meinem Verschlüsselungsprog miteinbauen; da bräucht ich aber schon so um die 80%. Wäre jedenfalls schön. Für die Phrasen hab ich die Lutherbibel genommen und mit Cryptool analysiert. Sollte also schon etwa stimmen; auch wenn hebräisch und griechisch das etwas verfälschen. Dass die Kompression jetzt richtig arbeitet, habe ich mit folgendem Prog getestet (kann ja vielleicht auch mal noch jemand brauchen):
Code: |
dim as integer i,j,k,m=10,n
dim as string datei1,datei2,text1,text2
input "Datei 1:",datei1
input "Datei 2:",datei2
print ""
open datei1 for binary access read as #1
text1=input(lof(1),#1)
close
open datei2 for binary access read as #1
text2=input(lof(1),#1)
close
if len(text1)<>len(text2) then
print "Datei 1:";len(text1);" Bytes"
print "Datei 2:";len(text2);" Bytes"
k=1
else print "Beide Dateien:";len(text1);" Bytes"
end if
for i=0 to len(text1)-1
if text1[i]<>text2[i] then
print
n=i+1
print "Datei 1: ";
for j=m to 1 step -1
if text1[n-j]<>0 then print mid(text1,n-j,1);
next
print mid(text1,n,1);
for j=1 to m
if text1[n+j]<>0 then print mid(text1,n+j,1);
next
print ""
print "Datei 2: ";
for j=m to 1 step -1
if text2[n-j]<>0 then print mid(text2,n-j,1);
next
print mid(text2,n,1);
for j=1 to m
if text2[n+j]<>0 then print mid(text2,n+j,1);
next
print ""
print ""
print "Falsche Byte-Nr.:";n
print ""
print "Datei ist manipuliert!!"
sleep
end
end if
next
if k=0 then
print ""
print "Dateien sind identisch."
else print "Datei ist manipuliert!!"
end if
sleep
end |
Zuletzt bearbeitet von Input am 11.08.2015, 21:55, insgesamt einmal bearbeitet |
|
Nach oben |
|
 |
Haubitze
Anmeldungsdatum: 14.10.2009 Beiträge: 132
|
Verfasst am: 10.08.2015, 12:28 Titel: |
|
|
hallo
ich wuerde zB auch hinter jedem if then noch ein continue do setzen.
warum:
beim packen hast du ja wenn ein if zutrifft etwas gefunden, du brauchst also nicht mehr weiter suchen. ausserdem gehts du damit sicher du so das zB
solche dinge auch findest, "und das der baum" oder "und die Frau das Glas"
beim entpachen hast du wenn ein if zutrifft ja auch etwas(ein token) gefunden. ergo du musst auch hier nicht weiter suchen.
salute
PS: kann auch sein das ich wieder hn hitzekollaps hab  |
|
Nach oben |
|
 |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
Verfasst am: 10.08.2015, 13:11 Titel: |
|
|
Ja, danke. Das bringt auch wieder 1.5% mehr Kompression, und langsamer wird's dadurch sicher auch nicht.
EDIT: Jetzt hab ich aber wieder Fehlermeldungen.  |
|
Nach oben |
|
 |
Jojo alter Rang

Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 10.08.2015, 13:35 Titel: |
|
|
Wenn du ernsthaft daran interessiert bist, eine einigermaßen solide Kompression zu bauen, solltest du dir mal die Huffman-Kodierung ansehen - diese kann zu jedem Input ein optimales Code-Wörterbuch erstellen - wie du selbst schon bemerkt hast, ist dein festes Code-Wörterbuch natürlich nur sehr eingeschränkt für Texte einer bestimmten Sprachr nutzbar, und du schließt vorweg bestimmte Textzeichen komplett von der Benutzung aus.
Huffman ist ein wichtiger Schritt in vielen modernen Kompressionsverfahren. _________________ » Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
Nach oben |
|
 |
grindstone
Anmeldungsdatum: 03.10.2010 Beiträge: 1279 Wohnort: Ruhrpott
|
Verfasst am: 11.08.2015, 12:08 Titel: |
|
|
@Jojo: Ohne mich jetzt wirklich eingehend damit befasst zu haben: Ist bei der Huffman - Codierung nicht spätestens beim 10. Zeichen des Quellalphabets der Punkt erreicht, wo das Codewort länger ist als der entsprechende ASCII-Code des Buchstabens?
Gruß
grindstone _________________ For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
Nach oben |
|
 |
dreael Administrator

Anmeldungsdatum: 10.09.2004 Beiträge: 2529 Wohnort: Hofen SH (Schweiz)
|
Verfasst am: 11.08.2015, 12:46 Titel: |
|
|
Noch schlauer: Gerade im Linux-Bereich gibt es bekanntlich gzib, bzip2 usw., dabei stehen die eigentlichen Kompressions- und Dekompressionsroutinen auch als Bibliotheken zur Verfügung. => Dürfte vermutlich kein Hexenwerk sein, mittels entsprechendem FB-Headerfile (API) eine solche Bibliothek zu benutzen. Vorteil: Das Rad muss nicht erneut erfunden werden.
Lektüre:
http://www.bzip.org/1.0.3/bzip2-manual-1.0.3.html#libprog
@Profis: Wäre vielleicht gut, ein FB-Beispiel zu bauen, welches einen Byte-Array komprimiert und dekomprimiert. _________________ Teste die PC-Sicherheit mit www.sec-check.net |
|
Nach oben |
|
 |
St_W

Anmeldungsdatum: 22.07.2007 Beiträge: 956 Wohnort: Austria
|
Verfasst am: 11.08.2015, 13:49 Titel: |
|
|
@dreael: FB liefert bereits Header und Beispiele für u.a. zlib, bzip2 und libzip mit, wenn man existierende Bibliotheken verwenden möchte.
Ich denke dass es hier aber eher um den Lerneffekt geht, wobei es sicher nicht schaden kann sich einmal mit dem Huffman Algorithmus auseinanderzusetzen. _________________ Aktuelle FreeBasic Builds, Projekte, Code-Snippets unter http://users.freebasic-portal.de/stw/
http://www.mv-lacken.at Musikverein Lacken (MV Lacken) |
|
Nach oben |
|
 |
Jojo alter Rang

Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 11.08.2015, 13:52 Titel: |
|
|
grindstone: Huffman basiert auf einer Häufigkeitsverteilung. Wenn du einen nicht optimalen Baum erstellst und besonders häufig verwendete Zeichen einem besonders langen Pfad im Baum zuweist, ist das natürlich äußerst doof. Manche Zeichen werden einen langen Pfad haben, aber die häufigsten Zeichen können eben mit nur wenigen Bit kodiert werden. Die Anzahl der benötigten Bits wächst allerdings logarithmisch, d.h. du brauchst nicht 10 Bit für 10 verschiedene Zeichen. _________________ » Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
Nach oben |
|
 |
grindstone
Anmeldungsdatum: 03.10.2010 Beiträge: 1279 Wohnort: Ruhrpott
|
Verfasst am: 11.08.2015, 20:09 Titel: |
|
|
Zum Thema Lerneffekt: Mir ist die Tunstall-Kodierung irgendwie einsichtiger.
Und wenn es nur um die Komprimierung und ein schnelles Erfolgserlebnis geht, wäre auch die Kommandozeilenversion von 7Zip eine Alternative.
Gruß
grindstone _________________ For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
Nach oben |
|
 |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
|
Nach oben |
|
 |
grindstone
Anmeldungsdatum: 03.10.2010 Beiträge: 1279 Wohnort: Ruhrpott
|
Verfasst am: 11.08.2015, 22:42 Titel: |
|
|
Viel Spaß beim Durchackern
Gruß
grindstone _________________ For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen! |
|
Nach oben |
|
 |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
Verfasst am: 13.08.2015, 20:35 Titel: |
|
|
Edit: So, hab jetzt mal noch etwas dran rumgebastelt:
Code: |
dim as integer vorhanden(255),nicht_vorhanden(255),wert(255)
dim as string gramm(255),index(255)
dim as integer i,j,m,n,zahl_vorhanden,zahl_nicht_vorhanden
dim as string text,wort
open "Finden.txt" for binary access read as #1
text=input(lof(1),#1)
close
'suche zeichen
for i=0 to 255
if instr(text,chr(i))>0 then
vorhanden(m)=i:m+=1:zahl_vorhanden+=1
else
nicht_vorhanden(n)=i:n+=1:zahl_nicht_vorhanden+=1
end if
next
'suche n-gramme
do
do
m+=1
loop until m>n-3
wort=(mid(text,m,3))
for i=0 to zahl_vorhanden
if index(i)=wort then wert(i)+=1:exit for
if wert(i)=0 then index(i)=wort:wert(i)=1:exit for
next
if wort="" then exit do
loop until m>len(text)-3
n=0
for j=len(text) to 0 step -1
for i=0 to zahl_vorhanden
if wert(i)=0 then exit for
If j=wert(i) then gramm(n)=index(i):n+=1
next
next
'kompression
open "Text.txt" for output as #1
i=0
do
for j=0 to zahl_nicht_vorhanden
if text[i]=asc(left(gramm(j),1)) and text[i]=asc(right(gramm(j),1)) _
and text[i]=asc(right(gramm(j),1)) then print #1,nicht_vorhanden(j);:i+=3
next
print #1,chr(text[i]);:i+=1
loop until i>len(text)-3
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);
close
'dekompression
open "Text2.txt" for output as #1
i=0
do
for j=0 to zahl_nicht_vorhanden
if text[i]=nicht_vorhanden(j) then print #1,gramm(j);:i+=1
next
print #1,chr(text[i]);:i+=1
loop until i>=len(text)-3
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);:i+=1
print #1,chr(text[i]);
close
end
|
Zuletzt bearbeitet von Input am 15.08.2015, 14:17, insgesamt 9-mal bearbeitet |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4702 Wohnort: ~/
|
Verfasst am: 13.08.2015, 21:09 Titel: |
|
|
Allein schon durch die bloße Fülle an möglichen Dreierkombinationen (bei einem Zeichenvorrat von 33 bis 255 sind das 223^3 = 11 089 567 Kombinationen, für die du alle den kompletten Text mehrmals durchgehst) ist klar, dass es ziemlich lange dauern wird. Ansonsten könnte man noch versuchen, die Anzahl der benötigten Textdurchläufe (einschließlich INSTR) zu minimieren. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
Input
Anmeldungsdatum: 28.07.2014 Beiträge: 59
|
Verfasst am: 13.08.2015, 21:24 Titel: |
|
|
Ja, da muss ich sicher noch dran basteln; ich hab aber ehrlich gesagt auch noch nicht wirklich so den Durchblick.  |
|
Nach oben |
|
 |
|
|
Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten. Du kannst deine Beiträge in diesem Forum nicht bearbeiten. Du kannst deine Beiträge in diesem Forum nicht löschen. Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|