Ontani

Public Class Init

    Public Shared AddS As New List(Of String)
    Public Shared AddEren As New List(Of String)
    Public Shared AddDeren As New List(Of String)
    Public Shared AddExceptions As New Dictionary(Of String, String)

    Public Shared Sub InitializeApplication()
        'Woorden die eindigen op 1 van deze karakters krijgen een -s
        AddS.Add("e")
        AddS.Add("a")
        AddS.Add("i")
        AddS.Add("o")
        AddS.Add("u")
        AddS.Add("y")
        AddS.Add("em")
        AddS.Add("el")
        AddS.Add("er")
        AddS.Add("en")
        AddS.Add("ie")

        'Woorden in deze lijst krijgen -eren
        AddEren.Add("ei")
        AddEren.Add("gemoed")
        AddEren.Add("kalf")
        AddEren.Add("kind")
        AddEren.Add("lam")
        AddEren.Add("lied")
        AddEren.Add("rund")

        'Woorden in deze lijst krijgen -deren
        AddDEren.Add("been")
        AddDEren.Add("hoen")

        'Woorden in deze lijst hebben geen of een speciaal meervoud
        AddExceptions.Add("data", "data")
        AddExceptions.Add("weer", "weer")
        AddExceptions.Add("vat", "vaten")
        AddExceptions.Add("dag", "dagen")
        AddExceptions.Add("dak", "daken")
        AddExceptions.Add("pad", "paden")
        AddExceptions.Add("dal", "sloten")
        AddExceptions.Add("weg", "wegen")

    End Sub

End Class

<HideModuleName()> _
Module Extensions

    <Runtime.CompilerServices.Extension()> _
    Public Function ToProper(ByVal str As String) As String
        Return StrConv(str, VbStrConv.ProperCase)
    End Function

    <Runtime.CompilerServices.Extension()> _
    Public Function ToPlural(ByVal str As String) As String
        Dim result As Result

        'Check uitzonderingen
        result = CheckExceptions(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden in de lijst van -deren
        result = CheckDeren(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden in de lijst van -eren
        result = CheckEren(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die eindigen op -or
        result = CheckOr(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die eindigen op -us
        result = CheckUs(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die eindigen op -um
        result = CheckUm(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die een lange klank hebben
        result = CheckAA(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden met een korte klank en die eindigen met 1 medeklinker
        result = CheckA(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die eindigen op s of f
        result = CheckFS(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden die eindigen op 2 medeklinkers
        result = CheckZZ(str)
        If result.Result Then : Return result.Value
        End If

        'Check voor woorden in de lijst van -s
        result = CheckS(str)
        If result.Result Then : Return result.Value
        End If

        'Geef -en terug als het niet voorkomt in de controles
        Return str & "en"
    End Function

    Private Function CheckExceptions(ByVal str As String) As Result
        If Init.AddExceptions.Keys.Contains(str.ToLower) Then
            Return New Result() With {.Result = True, .Value = Init.AddExceptions(str.ToLower)}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
        Return Nothing
    End Function

    Private Function CheckDeren(ByVal str As String) As Result
        If Init.AddDeren.Contains(str.ToLower) Then
            Return New Result() With {.Result = True, .Value = str & "deren"}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
        Return Nothing
    End Function

    Private Function CheckEren(ByVal str As String) As Result
        If Init.AddEren.Contains(str.ToLower) Then
            Return New Result() With {.Result = True, .Value = str & "eren"}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
        Return Nothing
    End Function

    Private Function CheckAA(ByVal str As String) As Result
        Dim iLength As Integer = str.Length - 1

        If CheckVowel(str(iLength - 1)) Then
            If str(iLength - 1) = str(iLength - 2) Then

                If str(iLength) = "s" Then
                    Return New Result() With {.Result = True, .Value = str.Remove(iLength - 1, 2) & "zen"}
                End If

                If str(iLength) = "f" Then
                    Return New Result() With {.Result = True, .Value = str.Remove(iLength - 1, 2) & "ven"}
                End If

                Return New Result() With {.Result = True, .Value = str.Remove(iLength - 1, 1) & "en"}
            Else
                Return New Result() With {.Result = False, .Value = str}
            End If
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If

    End Function

    Private Function CheckZZ(ByVal str As String) As Result
        Dim iLength As Integer = str.Length - 1

        If Not CheckVowel(str(iLength)) Then
            If Not CheckVowel(str(iLength - 1)) Then
                Return New Result() With {.Result = True, .Value = str & "en"}
            Else
                Return New Result() With {.Result = False, .Value = str}
            End If
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If

    End Function

    Private Function CheckA(ByVal str As String) As Result
        Dim iLength As Integer = str.Length - 1

        'Voorlaatste letter is een klinker
        If CheckVowel(str(iLength - 1)) Then
            'Derdelaatste letter is geen medeklinker
            If Not CheckVowel(str(iLength - 2)) Then
                'Laatste letter is een medeklinker
                If Not CheckVowel(str(iLength)) Then
                    Return New Result() With {.Result = True, .Value = str & str(iLength) & "en"}
                Else
                    Return New Result() With {.Result = False, .Value = str}
                End If
            Else
                Return New Result() With {.Result = False, .Value = str}
            End If
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
    End Function

    Private Function CheckOr(ByVal str As String) As Result
        If str.ToLower.EndsWith("or") Then
            Return New Result() With {.Result = True, .Value = str & "en"}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
    End Function

    Private Function CheckUs(ByVal str As String) As Result
        If str.ToLower.EndsWith("us") Then
            Return New Result() With {.Result = True, .Value = str.Substring(0, str.Length - 2) & "i"}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
    End Function

    Private Function CheckUm(ByVal str As String) As Result
        If str.ToLower.EndsWith("um") Then
            Return New Result() With {.Result = True, .Value = str.Substring(0, str.Length - 2) & "a"}
        Else
            Return New Result() With {.Result = False, .Value = str}
        End If
    End Function

    Private Function CheckFS(ByVal str As String) As Result
        If str.ToLower.EndsWith("s") Then
            Return New Result() With {.Result = True, .Value = str.Substring(0, str.Length - 1) & "zen"}
        End If

        If str.ToLower.EndsWith("f") Then
            Return New Result() With {.Result = True, .Value = str.Substring(0, str.Length - 1) & "ven"}
        End If

        Return New Result() With {.Result = False, .Value = str}
    End Function

    Private Function CheckS(ByVal str As String) As Result
        For Each s As String In Init.AddS

            If str.ToLower.EndsWith(s) Then
                If Not CheckVowel(str(str.IndexOf(s))) Then
                    Return New Result() With {.Result = True, .Value = str & "s"}
                End If
            End If
        Next
        Return New Result() With {.Result = False, .Value = str}
    End Function

    Private Function CheckVowel(ByVal str As String) As Boolean
        Return IIf(str = "a" Or str = "e" Or str = "i" Or str = "o" Or str = "u" Or str = "y", True, False)
    End Function

    Private Class Result

        Private _Result As Boolean = False
        Private _Value As String = ""

        Public Property Result() As Boolean
            Get
                Return Me._Result
            End Get
            Set(ByVal value As Boolean)
                Me._Result = value
            End Set
        End Property

        Public Property Value() As String
            Get
                Return Me._Value
            End Get
            Set(ByVal value As String)
                Me._Value = value
            End Set
        End Property

    End Class

End Module

'Example
Imports Project.Extensions

Module Main

    Sub Main()

        MsgBox("Catalogus".ToPlural)

    End Sub

End Module