Mega Code Archive

 
Categories / Delphi / Examples
 

Neoturk forum - pixel list compressing [ genius ]

" 13 Aralık 2005 20:25 Pixel List Compressing. 2 Ekran Görüntüsünün Pixellerinin Karşılaştırılıp, Değişen Pixel Değerlerinin Listesi Üzerinde Nasıl Daha Hızlı ve Daha Az Cpu Kullanımı ile Sıkıştırma Yaparım. Çözme Kısmının Hızı Önemli Değil. Sıkıştırma Kısmı Önemli İstediğim Sıkıştırma zlib/zip/rar Değil. Bu Tarz Fikir Önerileri işime yaramaz. Pixel List için kendi yazdığım bir sıkıştırma algoritması var. Eğer Daha iyisi yok ise bu kodda nasıl daha fazla optimize yaparız ? Sıkıştırılmamış Pixel Listesi; http://www.g3nius.net/Pixels.rar Kendi Yazdığım Kodla Sıkıştırılmış Liste; http://www.g3nius.net/Result.rar Görüldüğü üzere kendimiz kod tabanlı sıkıştırma yaptıkdan sonra; üzerine rar la geçtiğimizde boyutların ne kadar küçüldüğünü öğrenmiş olduk LOMLib Yerine TStringList için Classes Tanımlanabilir. - Benim Yazdığım Kod - Program CPL; Uses Windows, LOMLib; Var Lines:TStrList; Function FindIt(Start:Longint; Bilgi:String; Aranan:Char):Longint; Var I:Longint; Begin For I:=Start To LEngth(Bilgi) Do If (Bilgi[I]=Aranan) Then BeGin FindIt:=I; Exit; End; FindIt:=0; End; Function MidStr(Bilgi:String; Basla,Bitir:Longint):String; Var I:Longint; Bos:String; Begin Bos:=''; If (Length(Bilgi)<Basla) Then Exit; For I:=Basla To Bitir Do Bos:=Bos+Bilgi[I]; MidStr:=Bos; End; Function GetSegmentValue(Data:String; SNo:Byte):String; Var N1,N2,N3:Byte; Begin N1:=FindIt(1,Data,'.'); N2:=FindIt(N1+1,Data,'.'); N3:=FindIt(N2+1,Data,'.'); If (SNo=1) Then Begin Result:=MidStr(Data,1,N1-1); Exit; End; If (SNo=2) Then Begin Result:=MidStr(Data,N1+1,N2-1); Exit; End; If (SNo=3) Then Begin Result:=MidStr(Data,N2+1,N3-1); Exit; End; If (SNo=4) Then Begin Result:=MidStr(Data,N3+1,Length(DatA)); Exit; End; Result:=''; End; Procedure Segment_Compress; Var NLines:TStrList; Line:String; NLine:String; OLine:String; I:Longint; Sv1, Sv2, Sv3, Sv4:String; SSv3:String; Begin NLines:=TStrList.Create; NLines.Clear; { ---- Compress C ---- } SSv3:=''; For I:=0 To Lines.Count-1 Do Begin Line:=Lines.Strings[I]; If (Length(Line)>0) Then Begin If (I=Lines.Count-1) Then Begin NLine:=''; End Else Begin NLine:=Lines.Strings[I+1]; End; Sv1:=GetSegmentValue(Line,1); Sv2:=GetSegmentValue(Line,2); Sv3:=GetSegmentValue(Line,3); Sv4:=GetSegmentValue(Line,4); { Segment 3 } If (Length(NLine)>0) And (Sv1 = GetSegmentValue(NLine,1)) And (Sv2 = GetSegmentValue(NLine,2)) And (Sv4 = GetSegmentValue(NLine,4)) And (StrToInt(Sv3)+1 = StrToInt(GetSegmentValue(NLine,3))) Then Begin If (SSv3='') Then Begin SSv3:=Sv3; End; End Else Begin If (SSv3='') Then Begin NLines.Add(Sv1+'.'+Sv2+'.'+Sv3+'.'+Sv4); End Else Begin NLines.Add(Sv1+'.'+Sv2+'.'+SSv3+'-'+Sv3+'.'+Sv4); SSv3:=''; End; End; End; End; { ---- Compress A,B,D ---- } Lines.Clear; For I:=0 To NLines.Count-1 Do Begin Line:=NLines.Strings[I]; If (Length(Line)>0) Then Begin If (I>0) Then Begin OLine:=NLines.Strings[I-1]; End Else Begin OLine:=''; End; If (I=Lines.Count-1) Then Begin NLine:=''; End Else Begin NLine:=NLines.Strings[I+1]; End; Sv1:=GetSegmentValue(Line,1); Sv2:=GetSegmentValue(Line,2); Sv3:=GetSegmentValue(Line,3); Sv4:=GetSegmentValue(Line,4); If (Length(OLine)>0) And (Length(NLine)>0) And (Sv1=GetSegmentValue(OLine,1)) Then Sv1:=''; If (Length(OLine)>0) And (Length(NLine)>0) And (Sv2=GetSegmentValue(OLine,2)) Then Sv2:=''; If (Length(OLine)>0) And (Length(NLine)>0) And (Sv4=GetSegmentValue(OLine,4)) Then Sv4:=''; Lines.Add(Sv1+'.'+Sv2+'.'+Sv3+'.'+Sv4); End; End; NLines.Clear; NLines.Destroy; End; Begin Lines:=TStrList.Create; Lines.LoadFromFile('Pixels.txt'); Segment_Compress; Lines.SaveToFile('Result.Txt'); Lines.Destroy; End; [CXC]GeNiUS *************************************************************************** 13 Aralık 2005 21:14 merhaba genius, kodu ve algoritmanı inceleyeceğim, büyük bir zevkle ! koda şu anda kabaca göz kararı baktım, biraz daha optimize edilebilir kanısındayım detaylı bir analiz ve incelemeden sonra gerekli raporu vereceğim dostum, yazdığın kod için bizzat teşekkür ediyorum sana, frekansımızın uyuştuğu kanaatindeyim............. not-1: verdiğin linkdeki dosyaları indiremedim not-2: örnek textlerini görmek için sabırsızlanıyorum, ben de kendimce bir sıkıştırma ve kod optimazsyonu yapmak istiyorum. birbiri ile kıyaslarız, rekabet kaliteyi doğrurur saygılarımla_ neoturk_ *************************************************************************** Sıkıştırılmamış Pixel Listesi; http://www.g3nius.net/Pixels.rar Kendi Yazdığım Kodla Sıkıştırılmış Liste; http://www.g3nius.net/Result.rar linklerde sorun yok dosya isimleri büyük harf içeriyor sunucuda. küçük harf yapmayı denedi isen indirememişsindir. hala indiremedi isen; mail adresine yollayabilirim. benim kanımca 400 kb lık stringlist içinde for ile satır satır okuma yapmamak lazım veya yaptı isen a.b.c.d için . ların konumunu bulmak için ilgili fonksiyonlardan daha iyi bir fonksiyon kullanmak lazımki kod dahada hızlı olsun. çıktıyı zlib ile sıkıştırdığımda(stream içinde) 12 kb oluyor buda ekranın değişen bir kısmının 256 adsl ile sn de 8 kb lık upload ile hızlıca ve yüksek kalitede aktarılmasını sağlıyor... [CXC]GeNiUS *************************************************************************** cevap: öncelikle sana teşekkür etmek istiyorum, görünüşü kolay, ama algoritması gerçekten zor bir soruydu. epey uğraştırdı beni. en çok zorlandığım nokta ise, verilen bir dizi aralığında hangi blokların seri sayılar olduğunu bulup çıkartması idi. bunu kodlarken epeyce zorlandım. konuya kısa bir açıklama getirmek istiyorum: örnek: 12345678 serisi sıralı bir seri midir ? cevap: evet 1234578 serisi sıralı bir seri midir ? cevap: hayır peki o zaman, sıralı seri olduğu kadarını ayrıştır? (1-2-3-4) (7-8) 7891011 serisi sıralı bir seri midir ? cevap: evet 89101112141516 serisi sıralı bir seri midir ? cevap: hayır peki o zaman, sıralı seri olduğu kadarını ayrıştır? (8-9-10-11-12) (14-15-16) bu mantığı kodlayana kadar göbeğim çatladı................... çünkü, görünüşü kolay ama kodlanışı epeyce zor idi. bunu kağıt üzerinde matematiksel bir functiona döktüğümde, seri olan bir dizinin seri olup olmadığını şöyle bir formülle anladım: " 1'den n'e kadar olan sayısal toplam, S0'dan Sn'e kadar olan farktoplamına eşit ise, bu seri gerçek bir sıralı seridir (bunu sana kağıt üzerinde gösterip anlatmak isterdim) " formülü çok zor geliştirdim.. önce kağıt üzerinde bu konuya yöneldim. 1 günümü aldı. daha sonra kodlamasına geçtim, bu da 1 günümü aldı. son günde de sıkıştırma algoritmasını yazdım kendimce. çünkü verilere ilk göz gezdirdiğimde daha iyi sıkıştırabileceğimi sezinledim. ve sonuçta da öyle oldu zaten... kalite bir soruydu... ilk etapda biraz tosladım duvara, ama limana ulaştım. gelelim sıkıştırma oranlarına: Ham veri = 401702 byte ( sıkıştırma oranı = %100 ) Genius result =105131 byte ( sıkıştırma oranı = %26 ) Neoturk Kurgulanmış veri = 179456 byte ( sıkıştırma oranı = %44) Neoturk algoritması - 1 = 88104 byte ( sıkıştırma oranı = %21 ) Neoturk algoritması - 2 = 83843 byte ( sıkıştırma oranı = %20 ) sıkıştırma oranları, result byte miktarının ana-pixel byte miktarına oranını belirtmektedir. Oranın düşük olması kalitenin arttığına işarettir. ilk yaptığım algoritmada ( kurgu aşamasında ) bunu %44 oranına düşürmeyi başardım, ama sana yetişemedim. seninki %26 ya kadar inikti. daha sonra farkettim ki sen sayısal serileri "n1-n2" şeklinde result dosyasına aktarmışsın, bu da çok güzel bir mantık idi. işte şu sayı serileri olayına bu yüzden çok fazla kastım. küçülte küçülte en sonra %20 ye kadar düşürdüm. result dosyaları sonuç olarak; ana_dosya = 402 KB genius_result = 105 KB (sıkıştırılmış halde) neoturk_result = 83 KB (sıkıştırılmış halde) aynı şekilde devamında zlib ile compress edildiğinde benim 30 KB daha avantajlı olduğumun farkındayım :) result farklılıkları nerelerden kaynaklanıyor ? açıklayayım, 1) senin result dosyandaki ".." karakterleri bence fazladan yer kaplıyor. o yüzden tekrar edilen bu karakterler boyutu şişiriyor. 2) ben result dosyamı 16lık hexadecimal formatına çevirerek yazdırıyorum, böylece her "255" olan 3 karakterlik bilgiyi "FF" olarak 2 karaktere indirgiyorum, bu da bir etken. 3) benim result dosyamda pek fazla karakter tekrarı yok. neyin nereye oturacağını biliyor program. 4) R.G.B karakterleri senin result dosyanda sürekli tekrarlanan bir yapıda. benimkinde ise sadece 3 adet geçiyor. 3 byte demek oluyor bu. 5) kurduğum algoritmanın işlem hızı biraz yavaş. bu konuda bişey diyemem. biraz fazla dolambaçlı yazdığım için hız optimizasyonu yapmadım. sonuçta iyi sıkıştırıyor diyebilirim. kurduğum algoritma tam olarak çalışır mı ? 3er bloklu x.x.x tarzındaki sayılardan oluşan ve sayı aralıkları 100-999 arasında olan bir metni sorunsuz sıkıştırır kanısındayım. zlib ile de süslenip paket hazırlanabilir. programda zaten yazarken, bir an aklımdan geçirdim, eğer 9999 adlı bir değer geçerse burada çuvallar bu kod dedim kendime. o yüzden çok geniş düşünmedim yazarken. ama gereken optimizasyonu rahat bir şekilde yapabilirim sorun olmaz. benimkinin işlem hızı biraz yavaş (2-3 sn filan sürüyor benim pc de) programda da zaten aşamalarını memolar içerisinde gösteriyorum. benim result dosyam "neoturk algoritması-2" yazan memonun içindeki satırlardır. incelemeni tavsiye ederim. farklılıkları görebilirsin. sorduğun soru gerçekten zor bir soruydu. bulmaca puzzle programından daha çok zorlandım diyebilirim. programımı kaynak kodları ile birlikte yayınladım. kodları inceleyebilirsiniz. www.geocities.com/neoturk2003/genius.zip senin yazmış olduğun kodlara ilişkin biraz yorum yapmak istiyorum: " Function FindIt(Start:Longint; Bilgi:String; Aranan:Char):Longint; Var I:Longint; Begin For I:=Start To LEngth(Bilgi) Do If (Bilgi[I]=Aranan) Then BeGin FindIt:=I; Exit; End; FindIt:=0; End; " yukarıdaki kodu şu şekilde de yazabilirdin: ----------------- var posx:byte; posx:=pos(aranan,copy(bilgi,start,999); if posx=-1 then ..aranan_eleman.bulunamadı... else ..bulundu_ve_yeri_posx_dir... ----------------- " Function GetSegmentValue(Data:String; SNo:Byte):String; Var N1,N2,N3:Byte; Begin N1:=FindIt(1,Data,'.'); N2:=FindIt(N1+1,Data,'.'); N3:=FindIt(N2+1,Data,'.'); If (SNo=1) Then Begin Result:=MidStr(Data,1,N1-1); Exit; End; If (SNo=2) Then Begin Result:=MidStr(Data,N1+1,N2-1); Exit; End; If (SNo=3) Then Begin Result:=MidStr(Data,N2+1,N3-1); Exit; End; If (SNo=4) Then Begin Result:=MidStr(Data,N3+1,Length(DatA)); Exit; End; Result:=''; End; " yukarıdaki kodlamada blokları ayrıştırmak için epey uğraşmışsın: ------------------- ben bunu "getlines" adlı kendi yazdığım bir functionla yaptım. kullanımı: getlines(data,hangi_stringliste_gönderilecek,ayrac) örnek: getlines('123.333.555',mystringlist,'.'); sonuç olarak, mystringlist.strings[0]:=123 olur; mystringlist.strings[1]:=333 olur; mystringlist.strings[2]:=555 olur; olarak hazır blokları temin etmiş olurum. --------------------- " { Segment 3 } If (Length(NLine)>0) And (Sv1 = GetSegmentValue(NLine,1)) And (Sv2 = GetSegmentValue(NLine,2)) And (Sv4 = GetSegmentValue(NLine,4)) And (StrToInt(Sv3)+1 = StrToInt(GetSegmentValue(NLine,3))) Then Begin If (SSv3='') Then Begin SSv3:=Sv3; End; End Else Begin If (SSv3='') Then Begin NLines.Add(Sv1+'.'+Sv2+'.'+Sv3+'.'+Sv4); End Else Begin NLines.Add(Sv1+'.'+Sv2+'.'+SSv3+'-'+Sv3+'.'+Sv4); SSv3:=''; End; End; " yukarıdaki kodda resmen kafa patlatmışsın... ne demek istediğini anlıyorum...... begin-end yapılarını biraz daha küçültebilirsin. { Segment 3 } If (Length(NLine)>0) And (Sv1 = GetSegmentValue(NLine,1)) And (Sv2 = GetSegmentValue(NLine,2)) And (Sv4 = GetSegmentValue(NLine,4)) And (StrToInt(Sv3)+1 = StrToInt(GetSegmentValue(NLine,3))) Then Begin If (SSv3='') Then Begin SSv3:=Sv3; End; End Else If (SSv3='') Then NLines.Add(Sv1+'.'+Sv2+'.'+Sv3+'.'+Sv4); Else Begin NLines.Add(Sv1+'.'+Sv2+'.'+SSv3+'-'+Sv3+'.'+Sv4); SSv3:=''; End; şeklinde yeterli olacaktır.... diyeceklerim bu kadar genius, sorunu çok beğendim, kalite bir soruydu....... çok fazla glukoz harcamama sebep oldun, bunu bir şekilde telafi etmelisin :) görüşmek üzere, kendine iyi bak, kafanı da böyle zor şeylere yorma !! :) saygılarımla_ neoturk_