Run-Length enkoodaus

[Misthema]

Tällaisen innostuin sitten väsäämään, kun olin lueskelemassa internetsiä ja törmäsin tähän.

Korjauksia yms. ottaisin ihan mielelläni vastaan, koska tiedän että unisena koodaaminen ei aina tuota juuri sitä parasta tulosta.

Code: Select all

SCREEN 800,600

Dim _text As String
Dim tulos As String
_text = "Tämä on esimerkki 'run-length' enkoodauksesta"

Print _text

Print ""
Print "RLE tulos: "+RLE(_text,True)
WaitKey
End

Function RLE$(_line$,_print)
    Dim sum%
    Dim result$
    Dim _found$
    
    For i=1 To Len(_line)
        char$=Mid(_line,i,1)
            For f=0 To Len(_found)
                If char=Mid(_found,f+1,1)
                    uniq=False
                    Exit
                Else
                    uniq=True
                EndIf
            Next f
    
            If uniq Then
                _found=_found+char
                For k=1 To Len(_line)            
                    If char=Mid(_line,k,1) Then
                        sum=sum+1
                    EndIf
                Next k
                result=result+Str(sum)+Str(char)
                
                If _print Then Print char+": "+sum
            EndIf
        sum=0
    Next i
    
    Return result
EndFunction

EDIT:

Itseasiassa yllä oleva koodi ei olekaan oikea RLE (vaan se lähentelee Huffman Coding:ia), vaan alla oleva =D Mutta kuitenkin...

Code: Select all

' Päivitin aikaisemman koodinpätkän ja laitoin RLE:n funktioon parilla selventävällä kommentilla.
'** Esimerkkikoodi vv
teksti$ = "BBBBBBBBBBBBWBBBBBBBBBBWWBBBBBBWWWWWWBBBBBBBBBBBBBBB"

enkoodattu$ = RLE(teksti)

Print "RLE koodattu tulos on: "+enkoodattu
WaitKey
'** Esimerkkikoodi ^^


'RLE-funktio
Function RLE$(_line As String)
    
    Dim result As String
    Dim check As String
    Dim sum As Integer
    Dim oldc As String
    
    result = ""
    sum=1
    
    'Käydään annettu merkkijono läpi
    For i=1 To Len(_line)
        check$=Mid(_line,i,1) 'Otetaan tarkistusmerkki merkkijonosta
        If check=oldc Then 'Jos tarkistusmerkki on edelleen sama, lisätään summaan yksi (1)
            sum=sum+1
        Else 'Jos se ei olekaan enää sama, lisätään summa ja merkki palautusmerkkijonoon
            If i>1 Then 'Tämä siksi ettei lisätä pelkkää ykköstä ensimmäisellä tarkistuskerralla
                result=result+Str(sum)+Str(oldc)
                Print result
                sum=1 'Palautetaan summa takaisin seuraavaa merkkiä varten
            EndIf
        EndIf
        oldc=check 'Edellinen tarkistusmerkki
    Next i
    
    Return result 'Palautetaan enkoodattu tulos
EndFunction

[/edit]

[MaGetzUb]

Olisit voinut tekniikasta antaa pienen lausunnon, vaikka linkin laitoitkin wikipediaan..

[Misthema]

Olisit voinut tekniikasta antaa pienen lausunnon, vaikka linkin laitoitkin wikipediaan..

Aivan. Noh, unisena tuollaisia ei aina muista laittaa. =P

Lainaus suomenkielisestä wikipediasta:

RLE (Run-length Encoding) eli jakson pituuden koodaus on yksinkertaisin häviötön tiivistysmenetelmä. Siinä tutkitaan sisältääkö syöte useita samoja merkkejä peräkkäin. Mikäli näin on, ne korvataan laskurilla, joka kertoo toistuvien merkkien määrän, sekä yhdellä kappaleella itse merkkiä. Se soveltuu hyvin sellaiselle informaatiolle, jossa on useita samoina toistuvia jaksoja. Hyvä esimerkki tällaisesta informaatiosta on bittikarttakuva, vaikkapa näytönkaappaus, jossa voi olla pitkiäkin pätkiä samaa väriä. Tavalliseen tekstiin se ei sovellu, koska siinä ei useinkaan ole useita peräkkäisiä merkkejä.

Eli tuossa minun esimerkkikoodissani B vastaa mustaa pikseliä, ja W taasen valkoista. Toisinsanoen kyseinen merkkijono "BBBBBBBBBBBBWBBBBBBBBBBWWBBBBBBWWWWWWBBBBBBBBBBBBBBB" on bittikarttakuvan 'scanline' (eli vertikaalinen pikselirivistö) joka on RLE:n avulla tiivistetty.

Ylempi esimerkkikoodi, joka lähentelee Huffman koodausta, ei toimi samalla tavalla, koska se kadottaa merkkijonossa olevien merkkien paikan. Toisinsanoen et voi kyseistä koodausta purkaa takaisinpäin, koska et tiedä missä kohtaa merkkien kuuluisi olla.
Yritän vielä kuitenkin tehdä siitä oikean Huffman koodauksen, jahka tässä kerkiän.