Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Kompression

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 10.08.2015, 08:17    Titel: Kompression Antworten mit Zitat

Hallo liebes Forum. ': Ich mach da gerade etwas mir der Datenkompression rum grinsen, 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
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4702
Wohnort: ~/

BeitragVerfasst am: 10.08.2015, 09:53    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 10.08.2015, 12:21    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
Haubitze



Anmeldungsdatum: 14.10.2009
Beiträge: 132

BeitragVerfasst am: 10.08.2015, 12:28    Titel: Antworten mit Zitat

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 grinsen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 10.08.2015, 13:11    Titel: Antworten mit Zitat

Ja, danke. Das bringt auch wieder 1.5% mehr Kompression, und langsamer wird's dadurch sicher auch nicht. zwinkern

EDIT: Jetzt hab ich aber wieder Fehlermeldungen. mit den Augen rollen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 10.08.2015, 13:35    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1279
Wohnort: Ruhrpott

BeitragVerfasst am: 11.08.2015, 12:08    Titel: Antworten mit Zitat

@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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
dreael
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 2529
Wohnort: Hofen SH (Schweiz)

BeitragVerfasst am: 11.08.2015, 12:46    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
St_W



Anmeldungsdatum: 22.07.2007
Beiträge: 956
Wohnort: Austria

BeitragVerfasst am: 11.08.2015, 13:49    Titel: Antworten mit Zitat

@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
Benutzer-Profile anzeigen Private Nachricht senden
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 11.08.2015, 13:52    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1279
Wohnort: Ruhrpott

BeitragVerfasst am: 11.08.2015, 20:09    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 11.08.2015, 21:48    Titel: Antworten mit Zitat

Habe heute mal etwas gestöbert und dabei ein ganz brauchbares Buch gefunden: http://www.lntwww.de/downloads/Informationstheorie/Theorie/Inf_Kap2_gesamt.pdf
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1279
Wohnort: Ruhrpott

BeitragVerfasst am: 11.08.2015, 22:42    Titel: Antworten mit Zitat

Viel Spaß beim Durchackern zwinkern

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 13.08.2015, 20:35    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4702
Wohnort: ~/

BeitragVerfasst am: 13.08.2015, 21:09    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden
Input



Anmeldungsdatum: 28.07.2014
Beiträge: 59

BeitragVerfasst am: 13.08.2015, 21:24    Titel: Antworten mit Zitat

Ja, da muss ich sicher noch dran basteln; ich hab aber ehrlich gesagt auch noch nicht wirklich so den Durchblick. mit den Augen rollen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
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.

 Impressum :: Datenschutz