VB.NETでも独自のエンコーディングを実装したい(後編)

いきなり最終話

最近は再び艦これにハマりだした弊社です。 榛名殿がワンパンで駆逐艦を沈めたのち戦艦からのワンパン大破で即撤退という流れが一般化しつつあります。

そんなこんなでVB.NETでエンコーダ・デコーダを実装するというお話は規模を縮小してその分の時間を艦これに当てようと考えています。 とりあえず、以下の感じでいい感じにアレをアレします。

  • フォールバックは例外フォールバックのみ
  • 必要最小限しか実装しない

実装

実装の流れは前の記事でも書いた通り

  1. Encoderの実装
  2. Decoderの実装
  3. Encodingの実装
  4. 試しにエンコード・デコードをする
  5. 楽しい✌('ω'✌ )三✌('ω')✌三( ✌'ω')✌

の流れとなっております。

Public Class JyuchKanaEncoder
    Inherits Encoder

    ' めんどくさいのでとりあえず全部例外フォールバックで対応

    Public Sub New(encoding As Encoding)
        Me.Fallback = encoding.EncoderFallback
    End Sub

    Public Overrides Function GetByteCount(chars() As Char, index As Integer, count As Integer, flush As Boolean) As Integer
        ' 引数の検査も面倒なのでカット
        Dim result = 0
        For Each it In chars.Skip(index).Take(count)
            If IsDiscernibleChar(it) Then
                result += 1
            Else
                Throw New EncoderFallbackException()
            End If
        Next
        Return result
    End Function

    Public Overrides Function GetBytes(chars() As Char, charIndex As Integer, charCount As Integer, bytes() As Byte, byteIndex As Integer, flush As Boolean) As Integer
        Dim ci = byteIndex
        Dim consumed = 0

        For Each c In chars.Skip(charIndex).Take(charCount)
            Try
                Dim b = ConvertToByte(c)
                bytes(ci) = b
                ci += 1
                consumed += 1
            Catch ex As ArgumentException
                Throw New EncoderFallbackException()
            End Try
        Next
        Return consumed
    End Function

    Private Function IsDiscernibleChar(c As Char) As Boolean
        Dim point As Integer = Microsoft.VisualBasic.Strings.AscW(c)

        Select Case point
            Case &H0 ' NUL
                Return True
            Case &HA ' LF
                Return True
            Case &HD ' CR
                Return True
            Case &H20 ' SPACE
                Return True
            Case &H41 To &H7A ' LATIN ALPHABET
                Return True
            Case &H3000 ' IDSP
                Return True
            Case &H3041 To &H3093 ' HIRAGANA
                Return True
            Case Else ' OTHER
                Return False
        End Select
    End Function

    Private Function ConvertToByte(c As Char) As Byte
        Dim point As Integer = Microsoft.VisualBasic.Strings.AscW(c)

        Select Case point
            Case &H0 ' NUL
                Return &H0
            Case &HA ' LF
                Return &H1
            Case &HD ' CR
                Return &H2
            Case &H20 ' SPACE
                Return &H10
            Case &H41 To &H7A ' LATIN ALPHABET
                Return CByte(point - &H30)
            Case &H3000 ' IDSP
                Return &H50
            Case &H3041 To &H3093 ' HIRAGANA
                Return CByte(point - &H2FF0)
            Case Else ' OTHER
                Throw New ArgumentException()
        End Select
    End Function
End Class
Public Class JyuchKanaDecoder
    Inherits Decoder

    ' めんどくさいのでとりあえず全部例外フォールバックで対応

    Public Sub New(encoding As Encoding)
        Me.Fallback = encoding.DecoderFallback
    End Sub

    Public Overloads Overrides Function GetCharCount(bytes() As Byte, index As Integer, count As Integer) As Integer
        Dim result = 0
        For Each b In bytes.Skip(index).Take(count)
            If IsDiscernibleByte(b) Then
                result += 1
            Else
                ' 無慈悲な例外のスロー
                Throw New DecoderFallbackException()
            End If
        Next
        Return result
    End Function

    Public Overloads Overrides Function GetChars(bytes() As Byte, byteIndex As Integer, byteCount As Integer, chars() As Char, charIndex As Integer) As Integer
        Dim ci = charIndex
        Dim consumed = 0

        For Each b In bytes.Skip(byteIndex).Take(byteCount)
            Try
                Dim c = ConvertToChar(b)
                chars(ci) = c
                ci += 1
                consumed += 1
            Catch ex As Exception
                Throw New DecoderFallbackException()
            End Try
        Next
        Return consumed
    End Function

    Private Function IsDiscernibleByte(b As Byte) As Boolean
        Select Case b
            Case &H0 ' NUL
                Return True
            Case &H1 ' LF
                Return True
            Case &H2 ' CR
                Return True
            Case &H10 ' SPACE
                Return True
            Case &H11 To &H44 ' LATIN ALPHABET
                Return True
            Case &H50 ' IDSP
                Return True
            Case &H51 To &HA3 ' HIRAGANA
                Return True
            Case Else ' OTHER
                Return False
        End Select
    End Function

    Private Function ConvertToChar(b As Byte) As Char
        Select Case b
            Case &H0 ' NUL
                Return Microsoft.VisualBasic.Strings.ChrW(&H0)
            Case &H1 ' LF
                Return Microsoft.VisualBasic.Strings.ChrW(&HA)
            Case &H2 ' CR
                Return Microsoft.VisualBasic.Strings.ChrW(&HD)
            Case &H10 ' SPACE
                Return Microsoft.VisualBasic.Strings.ChrW(&H20)
            Case &H11 To &H44 ' LATIN ALPHABET
                Return Microsoft.VisualBasic.Strings.ChrW(b + &H30)
            Case &H50 ' IDSP
                Return Microsoft.VisualBasic.Strings.ChrW(&H3000)
            Case &H51 To &HA3 ' HIRAGANA
                Return Microsoft.VisualBasic.Strings.ChrW(b + &H2FF0)
            Case Else ' OTHER
                Throw New ArgumentException()
        End Select
    End Function
End Class
Public Class JyuchKanaEncoding
    Inherits Encoding


    Public Sub New()
    End Sub

    Public Overloads Overrides Function GetByteCount(chars() As Char, index As Integer, count As Integer) As Integer
        Dim e = New JyuchKanaEncoder(Me)
        Return e.GetByteCount(chars, index, count, True)
    End Function

    Public Overloads Overrides Function GetBytes(chars() As Char, charIndex As Integer, charCount As Integer, bytes() As Byte, byteIndex As Integer) As Integer
        Dim e = New JyuchKanaEncoder(Me)
        Return e.GetBytes(chars, charIndex, charCount, bytes, byteIndex, True)
    End Function

    Public Overrides Function GetBytes(s As String) As Byte()
        Return MyBase.GetBytes(s)
    End Function

    Public Overloads Overrides Function GetCharCount(bytes() As Byte, index As Integer, count As Integer) As Integer
        Dim d = New JyuchKanaDecoder(Me)
        Return d.GetCharCount(bytes, index, count)
    End Function

    Public Overloads Overrides Function GetChars(bytes() As Byte, byteIndex As Integer, byteCount As Integer, chars() As Char, charIndex As Integer) As Integer
        Dim d = New JyuchKanaDecoder(Me)
        Return d.GetChars(bytes, byteIndex, byteCount, chars, charIndex)
    End Function

    Public Overrides Function GetString(bytes() As Byte) As String
        Return MyBase.GetString(bytes)
    End Function

    Public Overrides Function GetMaxByteCount(charCount As Integer) As Integer
        ' 指定した文字数をエンコしたときに生成される最大のバイト数
        ' フォールバックされたときはバッファが返す文字数が分からないので
        ' フォールバック時は考慮しなくてok?
        Return charCount
    End Function

    Public Overrides Function GetMaxCharCount(byteCount As Integer) As Integer
        ' 指定したバイト数をデコードしたときに生成される最大文字数
        ' こっちもフォールバック時は気にしなくてok?
        Return byteCount
    End Function

    Public Overrides Function GetEncoder() As Encoder
        Return New JyuchKanaEncoder(Me)
    End Function

    Public Overrides Function GetDecoder() As Decoder
        Return New JyuchKanaDecoder(Me)
    End Function
End Class

とくにひねりもなく適当に足し算引き算しながら一対一で対応付けてるだけです。 なんかPythonのコードをそのままVBに移植したコードってかそのまんまです。

GetMaxByteCountGetMaxCharCountは最適フォールバックや置換フォールバックされた時はどんな文字が返されるときは予測ができないのでとりあえず正常に変換できた時のバイト数や文字数を返しています。これでいいんかな?

一応標準ライブラリなんかも参考にしたけどポインタの嵐でポインタがダメでC#に逃げてきた弊社にはすこし辛いものがありました。 あと、たった今CLIの規格票を読んでて知ったんだけどCLSに準拠してないメソッドは拡張側は実装しなくていいっぽい?*1

それで利用側はこんな感じ。

Imports こころぴょんぴょん = System.Console

Module Main

    Sub Main()
        Dim encoding = New JyuchKanaEncoding()

        ' Hello<SP>World<SP>こんにちは<IDSP>せかい
        Dim target = "Hello World こんにちは せかい"
        Dim dist = encoding.GetBytes(target)
        Dim decode = encoding.GetString(dist)

        こころぴょんぴょん.WriteLine(target)

        For Each b In dist
            こころぴょんぴょん.Write("{0:X2} ", b)
        Next
        こころぴょんぴょん.WriteLine()

        こころぴょんぴょん.WriteLine(decode)
    End Sub

End Module

散々煮え湯を飲まされているVBなのでせめてコンソールに文字を出力するときくらいはこころぴょんぴょんできるようにしてみました。

んで、一応出力結果がこれ。

Hello World こんにちは せかい
18 35 3C 3C 3F 10 27 3F 42 3C 34 10 63 A3 7B 71 7F 50 6B 5B 54
Hello World こんにちは せかい

多分うまく動いている。

まとめ

なんか突貫な上に解説っぽい解説もないので申し訳ないのですが、正直こんな感じていいのか弊社もわからないのでこんな感じなら一応できたってことで載せています。

msdnがお世辞にも見やすいとは言えないのとPythonみたいな実装に関するドキュメントも無いので調べるのに心が折れたって感じです。 まぁ、バレンタインデーに一人部屋に篭ってmsdnをタブ20ぐらい開いてVBに対する悪態をつきながらVisual Studio相手にカタカタキーボードを叩いている弊社も弊社ですけどね。

明日からはバレンタインの売れ残りで安く叩き売りされているチョコレートを買いあさって命をつなぐお仕事が始まります。

あと、今更なんですが、コード中のArgumentExceptionArgumentOutOfRangeExceptionの方が良かったんじゃないかと思いました。

*1:正確には実装を強要しちゃダメっぽい