microsoft-visualbasic-runtime/Extensions/Math/NumberGroups.vb

#Region "Microsoft.VisualBasic::216ff4ffa99cd78ad8f9ef7b6d573ef7, Microsoft.VisualBasic.Core\Extensions\Math\NumberGroups.vb"

    ' Author:
    ' 
    '       asuka (amethyst.asuka@gcmodeller.org)
    '       xie (genetics@smrucc.org)
    '       xieguigang (xie.guigang@live.com)
    ' 
    ' Copyright (c) 2018 GPL3 Licensed
    ' 
    ' 
    ' GNU GENERAL PUBLIC LICENSE (GPL3)
    ' 
    ' 
    ' This program is free software: you can redistribute it and/or modify
    ' it under the terms of the GNU General Public License as published by
    ' the Free Software Foundation, either version 3 of the License, or
    ' (at your option) any later version.
    ' 
    ' This program is distributed in the hope that it will be useful,
    ' but WITHOUT ANY WARRANTY; without even the implied warranty of
    ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ' GNU General Public License for more details.
    ' 
    ' You should have received a copy of the GNU General Public License
    ' along with this program. If not, see <http://www.gnu.org/licenses/>.



    ' /********************************************************************************/

    ' Summaries:

    '     Module NumberGroups
    ' 
    '         Function: BinarySearch, (+2 Overloads) GroupBy, GroupByImpl, GroupByParallel, Groups
    '                   Match, Min
    '         Interface IVector
    ' 
    '             Properties: Data
    ' 
    ' 
    ' 
    '     Interface INumberTag
    ' 
    '         Properties: Tag
    ' 
    ' 
    ' /********************************************************************************/

#End Region

Imports System.Runtime.CompilerServices
Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel
Imports Microsoft.VisualBasic.ComponentModel.TagData
Imports Microsoft.VisualBasic.Language
Imports Microsoft.VisualBasic.Linq
Imports Microsoft.VisualBasic.Math.Statistics
Imports Microsoft.VisualBasic.Parallel

Namespace Math

    ''' <summary>
    ''' Simple number vector grouping
    ''' </summary>
    Public Module NumberGroups

        ''' <summary>
        ''' The numeric vector model
        ''' </summary>
        Public Interface IVector
            ReadOnly Property Data As Double()
        End Interface

        <Extension>
        Public Function Match(Of T As IVector)(a As IEnumerable(Of T), b As IEnumerable(Of T)) As Double
            Dim target As New List(Of T)(a)
            Dim mins = b.Select(Function(x) target.Min(x))
            Dim result As Double = mins.Sum(Function(tt) tt.Tag)

            With target
                For Each x In mins.Select(Function(o) o.Value)
                    Call .Remove(item:=x)
                    If .Count = 0 Then
                        Exit For
                    End If
                Next
            End With

            Return result * (target.Count + 1)
        End Function

        ''' <summary>
        ''' 计算出<paramref name="target"/>集合之众的与<paramref name="v"/>距离最小的元素
        ''' （或者说是匹配度最高的元素）
        ''' </summary>
        ''' <typeparam name="T"></typeparam>
        ''' <param name="target"></param>
        ''' <param name="v"></param>
        ''' <returns></returns>
        <Extension>
        Public Function Min(Of T As IVector)(target As IEnumerable(Of T), v As T) As DoubleTagged(Of T)
            Dim minV# = Double.MaxValue
            Dim minX As T
            Dim vector#() = v.Data

            For Each x As T In target
                Dim d# = x.Data.EuclideanDistance(vector)

                If d < minV Then
                    minV = d
                    minX = x
                End If
            Next

            Return New DoubleTagged(Of T) With {
                .Tag = minV,
                .Value = minX
            }
        End Function

        ''' <summary>
        ''' Returns ``-1`` means no search result
        ''' </summary>
        ''' <param name="seq"></param>
        ''' <param name="target#"></param>
        ''' <param name="equals"></param>
        ''' <returns></returns>
        <Extension>
        Public Function BinarySearch(seq As IEnumerable(Of Double), target#, equals As GenericLambda(Of Double).IEquals) As Double
            With seq _
                .SeqIterator _
                .OrderBy(Function(x) x.value) _
                .ToArray

                Dim x As SeqValue(Of Double)
                Dim min% = 0
                Dim max% = .Length - 1
                Dim index%
                Dim value#

                If max = -1 Then
                    ' no elements
                    Return -1
                ElseIf max = 0 Then
                    ' one element
                    If equals(.ByRef(0).value, target) Then
                        Return 0
                    Else
                        ' 序列只有一个元素，但是不相等，则返回-1，否则后面的while会无限死循环
                        Return -1
                    End If
                End If

                Do While max <> (min + 1)
                    index = (max - min) / 2 + min
                    x = .ByRef(index)
                    value = x.value

                    If equals(target, value) Then
                        Return x.i
                    ElseIf target > value Then
                        min = index
                    Else
                        max = index
                    End If
                Loop

                If equals(.ByRef(min).value, target) Then
                    Return .ByRef(min).i
                ElseIf equals(.ByRef(max).value, target) Then
                    Return .ByRef(max).i
                Else
                    Return -1
                End If
            End With
        End Function

        ''' <summary>
        ''' 将一维的数据按照一定的偏移量分组输出
        ''' </summary>
        ''' <param name="source"></param>
        ''' <returns></returns>
        <Extension> Public Iterator Function GroupBy(Of T)(source As IEnumerable(Of T),
                                                           evaluate As Func(Of T, Double),
                                                           equals As GenericLambda(Of Double).IEquals) As IEnumerable(Of NamedCollection(Of T))
            ' 先进行预处理：求值然后进行排序
            Dim tagValues = source _
                .Select(Function(o) (evaluate(o), o)) _
                .OrderBy(Function(o) o.Item1) _
                .ToArray
            Dim means As New Average
            Dim members As New List(Of T)

            ' 根据分组的平均值来进行分组操作
            For Each x As (val#, o As T) In tagValues
                If means.N = 0 Then
                    means += x.Item1
                    members += x.Item2
                Else
                    If equals(means.Average, x.Item1) Then
                        means += x.Item1
                        members += x.Item2
                    Else
                        Yield New NamedCollection(Of T)(CStr(means.Average), members)

                        means = New Average({x.Item1})
                        members = New List(Of T) From {x.Item2}
                    End If
                End If
            Next

            If members > 0 Then
                Yield New NamedCollection(Of T)(CStr(means.Average), members)
            End If
        End Function

        ''' <summary>
        ''' 将一维的数据按照一定的偏移量分组输出
        ''' </summary>
        ''' <param name="source"></param>
        ''' <returns></returns>
        <Extension> Public Iterator Function GroupByParallel(Of T)(source As IEnumerable(Of T),
                                                                   evaluate As Func(Of T, Double),
                                                                   equals As GenericLambda(Of Double).IEquals,
                                                                   Optional chunkSize% = 20000) As IEnumerable(Of NamedCollection(Of T))
            Dim partitions = source _
                .SplitIterator(parTokens:=chunkSize) _
                .AsParallel _
                .Select(Function(part)
                            Return part.AsList.GroupByImpl(evaluate, equals)
                        End Function) _
                .IteratesALL _
                .AsList

            ' 先分割，再对name做分组
            Dim union = partitions.GroupByImpl(Function(part) Val(part.Name), equals)

            For Each unionGroup In union
                Dim name$ = unionGroup.Name
                Dim data = unionGroup _
                    .Value _
                    .Select(Function(member) member.Value) _
                    .IteratesALL _
                    .ToArray

                Yield New NamedCollection(Of T) With {
                    .Name = name,
                    .Value = data
                }
            Next
        End Function

        <Extension>
        Private Function GroupByImpl(Of T)(source As List(Of T), evaluate As Func(Of T, Double), equals As GenericLambda(Of Double).IEquals) As NamedCollection(Of T)()
            Dim tmp As New With {
                .avg = New Average({}),
                .list = New List(Of T)
            }
            Dim groups = {
                tmp
            }.AsList * 0

            Do While source.Count > 0
                Dim x As T = source.Pop
                Dim value# = evaluate(x)
                Dim hit% = groups _
                    .Select(Function(g)
                                Return g.avg.Average
                            End Function) _
                    .BinarySearch(value, equals)

                ' 在这里应该使用二分法查找来加快计算速度的
                If hit > -1 Then
                    With groups(hit)
                        .avg += value
                        .list.Add(x)
                    End With
                Else
                    groups += New With {
                        .avg = New Average({value}),
                        .list = New List(Of T) From {x}
                    }
                End If
            Loop

            Return groups _
                .Select(Function(tuple)
                            Return New NamedCollection(Of T) With {
                                .Name = tuple.avg.Average,
                                .Value = tuple.list
                            }
                        End Function) _
                .OrderBy(Function(tuple) Val(tuple.Name)) _
                .ToArray
        End Function

        ''' <summary>
        ''' 将一维的数据按照一定的偏移量分组输出
        ''' </summary>
        ''' <param name="source"></param>
        ''' <param name="offsets"></param>
        ''' <returns></returns>
        ''' 
        <MethodImpl(MethodImplOptions.AggressiveInlining)>
        <Extension> Public Function GroupBy(Of T)(source As IEnumerable(Of T), evaluate As Func(Of T, Double), offsets#) As NamedCollection(Of T)()
            Return source.GroupBy(evaluate, equals:=Function(a, b) Abs(a - b) <= offsets)
        End Function

        ''' <summary>
        ''' 按照相邻的两个数值是否在offset区间内来进行简单的分组操作
        ''' </summary>
        ''' <typeparam name="TagObject"></typeparam>
        ''' <param name="source"></param>
        ''' <param name="offset"></param>
        ''' <returns></returns>
        <Extension>
        Public Function Groups(Of TagObject As INumberTag)(source As IEnumerable(Of TagObject), offset As Integer) As GroupResult(Of TagObject, Integer)()
            Dim list As New List(Of GroupResult(Of TagObject, Integer))
            Dim orders As TagObject() = (From x As TagObject
                                         In source
                                         Select x
                                         Order By x.Tag Ascending).ToArray
            Dim tag As TagObject = orders(Scan0)
            Dim tmp As New List(Of TagObject) From {tag}

            For Each x As TagObject In orders.Skip(1)
                If x.Tag - tag.Tag <= offset Then  ' 因为已经是经过排序了的，所以后面总是大于前面的
                    tmp += x
                Else
                    tag = x
                    list += New GroupResult(Of TagObject, Integer)(tag.Tag, tmp)
                    tmp = New List(Of TagObject) From {x}
                End If
            Next

            If tmp.Count > 0 Then
                list += New GroupResult(Of TagObject, Integer)(tag.Tag, tmp)
            End If

            Return list
        End Function
    End Module

    Public Interface INumberTag
        ReadOnly Property Tag As Integer
    End Interface
End Namespace