Examples Delphi

"
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)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_