1 #Region "Microsoft.VisualBasic::fbb21f6b7839c9c68891c6e7a6946bb4, Microsoft.VisualBasic.Core\Extensions\Math\Random\RandomRange.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module RandomRange
35     
36     '         FunctionGetRandom, Testing
37     
38     
39     ' /********************************************************************************/
40
41 #End Region
42
43 Imports Microsoft.VisualBasic.ComponentModel.Ranges.Model
44 Imports Microsoft.VisualBasic.Language
45 Imports Microsoft.VisualBasic.Linq
46 Imports sys = System.Math
47
48 Namespace Math
49
50     ''' <summary>
51     ''' 针对负数到正数的range随机数,小数位最多精确到1E-4
52     ''' </summary>
53     Public Module RandomRange
54
55         ''' <summary>
56         ''' 
57         ''' </summary>
58         ''' <param name="from"></param>
59         ''' <param name="[to]"></param>
60         ''' <param name="INF"></param>
61         ''' <param name="forceInit">
62         ''' True的时候会通过牺牲性能来强制重新实例化随机数发生器来获取足够的随机
63         ''' </param>
64         ''' <returns></returns>
65         Public Function GetRandom(from#, to#, Optional INF% = 5, Optional forceInit As Boolean = FalseAs IValueProvider
66             Dim pf! = ScientificNotation.PowerLog10(from, INF), pt! = ScientificNotation.PowerLog10([to], INF)
67
68             If from > 0 Then
69                 If [to] > 0 Then ' from 是正数,则to也必须是正数
70                     If pf <> 0F Then  ' 如果from不是常数(极大数或者极小数),则整体当做极值数来看待
71                         Return AddressOf New PreciseRandom(pf, CSng(sys.Log10([to]))).NextNumber
72                     Else ' from 是常数  
73                         If pt > 0 Then ' 同样的,当to也是极值数的时候,整体也将被当做极值数来看待
74                             Return AddressOf New PreciseRandom(CSng(sys.Log10(from)), pt).NextNumber
75                         Else
76                             ' to 也是常数
77                             Dim range As New DoubleRange(from, [to])
78
79                             If forceInit Then
80                                 Return Function() New Random().NextDouble(range)  ' 想要通过牺牲性能来强制获取足够的随机
81                             Else
82                                 Dim rnd As New Random
83                                 Return Function() rnd.NextDouble(range)  ' 假若二者都是常数,则返回常数随机区间
84                             End If
85                         End If
86                     End If
87                 Else
88                     Throw New InvalidConstraintException(
89                         $"Can not creates a range as min is positive but max is negative! (from:={from}, to:={[to]})")
90                 End If
91             Else ' from是负数
92                 If [to] > 0 Then ' to 是正数
93                     If pf <> 0F OrElse pt <> 0F Then  ' from是极值数,则整体当做极值数来看待
94
95                         pf = sys.Log10(sys.Abs(from))
96                         pt = sys.Log10(sys.Abs([to]))
97
98                         Dim c!() = {0F, pf}
99                         Dim rf As New PreciseRandom(c.Min, c.Max)
100                         c = {0F, pt}
101                         Dim rt As New PreciseRandom(c.Min, c.Max)
102                         Dim ppf = sys.Abs(pf) / (sys.Abs(pf) + sys.Abs(pt))
103
104                         If forceInit Then
105                             Return Function()
106                                        If New Random().NextDouble < ppf Then
107                                            Return -1 * rf.NextNumber
108                                        Else
109                                            Return rt.NextNumber
110                                        End If
111                                    End Function
112                         Else
113                             Dim rnd As New Random
114                             Return Function()
115                                        If rnd.NextDouble < ppf Then
116                                            Return -1 * rf.NextNumber
117                                        Else
118                                            Return rt.NextNumber
119                                        End If
120                                    End Function
121                         End If
122                     Else
123                         Dim range As New DoubleRange(from, [to])
124                         If forceInit Then
125                             Return Function() New Random().NextDouble(range)
126                         Else
127                             Dim rnd As New Random
128                             Return Function() rnd.NextDouble(range)
129                         End If
130                     End If
131                 Else  ' to 同样也是负数的情况
132                     If pf <> 0F OrElse pt <> 0F Then ' 两个都是极值数
133
134                         pf = sys.Log10(sys.Abs(from))
135                         pt = sys.Log10(sys.Abs([to]))
136
137                         Dim c = {pf, pt}
138                         Dim rnd As New PreciseRandom(c.Min, c.Max)   ' 由于from要小于to
139                         Return Function() -1 * rnd.NextNumber
140                     Else  ' from 和 to 都是负实数
141                         Dim range As New DoubleRange(from, [to])
142                         If forceInit Then
143                             Return Function() New Random().NextDouble(range)
144                         Else
145                             Dim rnd As New Random
146                             Return Function() rnd.NextDouble(range)
147                         End If
148                     End If
149                 End If
150             End If
151         End Function
152
153         Public Function Testing(from#, to#) As Double()
154             Dim rnd As IValueProvider = GetRandom(from, [to])
155             Dim bufs As New List(Of Double)
156
157             For Each i% In 1000%.Sequence
158                 bufs += rnd()
159             Next
160
161             Return bufs
162         End Function
163     End Module
164 End Namespace