Начал изучать нейросети. Примеров на FreeBasic не нашёл, у кого есть хоть прототип выложите, а?
Наваял свой пример:
Код
/' Sinaps.bi '/
#Undef NULL #Define NULL CPtr(Any Ptr, 0)
#Undef Each #Macro Each(__iter__, __arr__) __index As Integer = LBound(__arr__) To UBound(__arr__) #Define __iter__ (__arr__(__index)) #EndMacro #Define In ,
#Undef MAX #define MAX(a, b) IIf((a) > (b), (a), (b)) #Undef range #define range(f,l) (Rnd*((l)-(f))+(f))
#Define len8(value__) Left(Str(value__),8)
#Define f(x) 1 / (1 + Exp(-(x)))
Function foi OverLoad( value_ As Double) As Double Return 1/(1 + Exp( -value_)) End Function
Function foi OverLoad( value_ As Double, ves_ As Double, offset_ As Double = 0) As Double Return 1/(1 + Exp( -(value_ * ( ves_ + offset_)))) End Function
Function relu OverLoad( value_ As Double) As Double Return max(value_, 0) End Function
'========== ' Sinaps '==========
Type Sinaps ' weights âåñà, weight âåñ Public: Declare Constructor() Declare Constructor( value_ As Double = 0)
Declare Property value( value_ As Double) Declare Property value() As Double
Declare Sub parents( value_() As Sinaps) Declare Sub child( value_ As Sinaps) Declare Sub predict( input_values_() As Sinaps, weight_values_() As Sinaps, add_weight_values_() As Sinaps) Declare Sub printAll()
next_ As Sinaps Ptr prev_(Any) As Sinaps Ptr Private: As Double value_ End Type
Sub Sinaps.parents( value_() As Sinaps) ReDim prev_( UBound( value_)) As Sinaps Ptr
For i As Integer = 0 To UBound(value_) this.prev_(i) = @value_(i) Next End Sub
Sub Sinaps.child( value_ As Sinaps) If @value_ = null Then next_ = null Else next_ = @value_ End Sub
Constructor Sinaps() next_ = null ReDim prev_(0) As Sinaps Ptr value_ = 0.0 End Constructor
Constructor Sinaps( value_ As Double = 0) next_ = null ReDim prev_(0) As Sinaps Ptr this.value_ = value_ End Constructor
Property Sinaps.value( value_ As Double) this.value_ = value_ End Property
Property Sinaps.value() As Double Return value_ End Property
Sub Sinaps.predict( input_values_() As Sinaps, weight_values_() As Sinaps, add_weight_values_() As Sinaps) For i As Integer = 0 To UBound( input_values_) 'weight_values_(i).value = range(0, 1) this.value = this.value + ( input_values_(i).value * weight_values_(i).value + add_weight_values_(i).value)
this.parents( input_values_()) input_values_(i).child( This) Next End Sub
Sub Sinaps.printAll() ? "Value = ";value ? "Child = ";@next_ For i As Integer = 0 To UBound( prev_) ? "Parent = ";@prev_(i);" [ Value = "; len8(prev_(i)->value) ;" ]" Next End Sub
Sub relu OverLoad( values_() As Sinaps) For i As Integer = 0 To UBound( values_) values_(i).value = max(values_(i).value, 0) Next End Sub
Sub f01( values_() As Sinaps) For i As Integer = 0 To UBound( values_) values_(i).value = f(values_(i).value) Next End Sub
Sub set_random( values_() As Sinaps) For i As Integer = 0 To UBound( values_) values_(i).value = range(0, 1) Next End Sub
Function argMax( value_() As Sinaps) As Integer Var pred_class = 0.0 Var k = 0
For i As Integer = 0 To UBound( value_) If value_(i).value > pred_class Then pred_class = value_(i).value k = i EndIf Next Return k End Function
Dim As String class_names(...) = { "Setosa", "Versicolor", "Virginica"} ? " Result = ";class_names( argMax( y())) ? Next /' For each(i in y) i.printall() ? Next '/ Sleep '/
polopok
Сообщение отредактировал ntvgjhfnj - Понедельник, 05.12.2022, 12:05
Добавлено (09.12.2022, 18:15) --------------------------------------------- Ссылка на видео взятое за основу: Нейронная сеть на Python с нуля Ссылка на использумый компонент np.bi: vectorArray Код примера адаптированного под Freebasic :
Var probs = np.Ar(0) probs = z Dim As Integer pred_class = np.ArgMax( probs) : ? "ArgMax = "; pred_class : ?
Dim As String class_name(...) = { "Setosa", "Versicolor", "Virginica"} Print " In classes: "; class_name(0);", "; class_name(1);", ";class_name(2) : ? Print " Predicted class: "; class_name( pred_class)
Sleep End
К сожалению пришлось присваивать значения через копирование. Если есть идеи , рассмотрю с удовольствием.
Добавлено (09.12.2022, 19:22) --------------------------------------------- Несколько изменений, расшаренные вектор-массивы для использования в функциях.
'a different mean #define my_mean(v1, v2) (Sqr(v1 / v2) * v2) ']
Declare Sub panic(text As String)
Namespace np Function Sig_d( v As double) As Double Scope ' : Dim k As Integer next_Iteration: If v > 1 Or v < -1 Then If instr(Str(v),".") Then v = Fix(v) - (v - Fix(v)) : ' k+=1 If v > 1 Or v < -1 Then GoTo next_Iteration Else v = Sgn(v) EndIf EndIf ': ? "iterration = ";k Return v End Scope End Function End Namespace
Namespace np '=============== ' vectorArray '=============== Type vectorArray Declare Constructor() Declare Operator Let( rhs As vectorArray) Declare Operator Let( rhs As Double) Declare Property Length( a As Integer) Declare Property Length() As Integer Declare Sub Print() Declare Sub Copy( a() As Double) Declare Sub Set( v As Double = 0) Declare Function Relu() As vectorArray Declare Function SoftMax() As vectorArray Declare Function Sig() As vectorArray
Arr(Any) As Double n(Any) As Integer End Type '[ Constructor, Length, Print, Copy, Set, Let Constructor vectorArray() ReDim Arr(0) As Double ReDim n(1) As Integer n(0) = 0 n(1) = 0 End Constructor
Property vectorArray.Length( a As Integer) If a <> 0 Then ReDim Preserve Arr( Abs(a) - 1) As Double Else ReDim Arr(0) As Double EndIf End Property
Property vectorArray.Length() As Integer Return UBound(Arr) + 1 End Property
Sub vectorArray.Print() If n(0) > 0 And n(1) = 0 Then For i As Integer = 0 To UBound(Arr) -1 ? Space(3);Format( Arr(i), "0.00000");" "; Next ? Space(3);Format( Arr( UBound(Arr)), "0.00000") ElseIf n(0) >= 0 And n(1) > 0 Then /' Array: ' Col 3 ' _______ ' |_|_|_| ' Row 4 |_|_|_| ' |_|_|_| ' |_|_|_| '/
For j As Integer = 0 To n(0) -1 ' col For i As Integer = 0 To n(1) -1 ' row If Arr(j + i * n(0)) < 0 Then ? Space(3);Format( Arr(j + i * n(0)), "0.00000");" "; Else ? Space(3);" "; Format( Arr(j + i * n(0)), "0.00000");" "; EndIf Next ? Next Else ? "Array is empty" EndIf End Sub
Sub vectorArray.Copy( a() As Double) Select Case UBound(a, 0) Case 1 If n(0) > 0 And n(1) = 0 Then If n(0) <> UBound(a)+1 Then panic("Array indexes are not equal !!!") For i As Integer = 0 To n(0) -1 Arr(i) = a(i) Next ElseIf n(0) >= 0 And n(1) > 0 Then For j As Integer = 0 To n(0) -1 For i As Integer = 0 To n(1) -1 Arr(j + i * n(0)) = a(j + i * n(0)) Next Next EndIf Case 2 If n(0) <> UBound( a,1)+1 And n(1) <> UBound( a,2)+1 Then panic("Array indexes are not equal !!!") For j As Integer = 0 To n(0) -1 For i As Integer = 0 To n(1) -1 Arr(j + i * n(0)) = a(j + i * n(0)) Next Next End Select End Sub
Sub vectorArray.Set( v As Double = 0) For i As Integer = 0 To UBound(arr) arr(i) = v Next End Sub
Function my_vectorArray Cdecl(ByRef fs As String, ...) As vectorArray Dim As Any Ptr arg = va_first() Dim j As Integer = 0, tr As boolean, s As String, ss As String = "" Dim As vectorArray temp
fs &= "," While j < Len(fs) If fs[j] = 34 Then tr = Not tr ' = "
If fs[j] <> 32 And tr = false Then ss &= Chr(fs[j]) ' = SPACE If tr Then ss &= Chr(fs[j]) j += 1 Wend fs = ss ': ? fs j = 0 : tr = true '? "--------------------------------------------------"
While j < Len(fs) If fs[j] = 34 Then tr = Not tr ' = "
s &= Chr(fs[j])
If fs[j] = 44 And tr Then ' = ,
s = Mid(s,1,Len(s)-1) ' ? s Select Case (s[0]) Case 48 To 57,45 ' Numbers ReDim Preserve temp.arr( UBound(temp.arr) +1) As Double
Operator vectorArray.Let( rhs As vectorArray) If @This <> @rhs Then If UBound( rhs.arr, 0) = 1 Then '? "v 1"', 'UBound(rhs.arr) ReDim This.arr( UBound(rhs.arr)) As Double '? Arr(0) For i As Integer = 0 To UBound(rhs.arr) '? i ,rhs.arr(i) , rhs.n(0) This.Arr(i) = rhs.arr(i) '? This.Arr(i) Next '? ReDim Preserve n(1) As Integer this.n(0) = rhs.n(0) this.n(1) = rhs.n(1) EndIf EndIf End Operator
Operator vectorArray.Let( rhs As Double) For i As Integer = 0 To UBound(arr) arr(i) = rhs Next End Operator ']
'[ Relu, SoftMax Function vectorArray.Relu() As vectorArray Dim As vectorArray temp ReDim temp.arr( n(0) -1) As Double
For i As Integer = 0 To UBound(arr) temp.arr(i) = max( arr(i), 0) Next
temp.n(0) = n(0) temp.n(1) = n(1)
Return temp End Function
Function vectorArray.SoftMax() As vectorArray Dim As vectorArray temp = This Dim As Double vectorArray_sum
For i As Integer = 0 To UBound(arr) temp.arr(i) = exp( arr(i)) vectorArray_sum += temp.arr(i) Next
If vectorArray_sum = 0 Then For i As Integer = 0 To UBound(arr) temp.arr(i) = 0 Next Else For i As Integer = 0 To UBound(arr) temp.arr(i) /= vectorArray_sum Next EndIf
Return temp End Function
Function vectorArray.Sig() As vectorArray Dim As vectorArray temp ReDim temp.arr( n(0) -1) As Double
For i As Integer = 0 To UBound(arr) temp.arr(i) = sig_d(arr(i)) Next
temp.n(0) = n(0) temp.n(1) = n(1)
Return temp End Function '] '[ Operators &, +, -, *, /
Operator & (lhs As vectorArray, rhs As vectorArray) As vectorArray Dim As vectorArray temp Dim As vectorArray lh, rh Dim As Integer select_ = 0
If lhs.n(0) = 0 And rhs.n(0) = 0 And lhs.n(1) = 0 And rhs.n(1) = 0 Then Return temp
If lhs.n(0) > 0 And lhs.n(1) = 0 And rhs.n(0) > 0 And rhs.n(1) = 0 Then select_ = 1 ElseIf lhs.n(0) > 0 And lhs.n(1) > 0 And rhs.n(0) > 0 And rhs.n(1) = 0 Then '? "W 1" lh = rhs rh = lhs select_ = 2 ElseIf lhs.n(0) > 0 And lhs.n(1) = 0 And rhs.n(0) > 0 And rhs.n(1) > 0 Then '? "W 2" lh = lhs rh = rhs select_ = 2 Else '? "W 3" lh = lhs rh = rhs 'select_ = 1 EndIf
Select Case select_ Case 1 ReDim temp.arr(0) As Double
For i As Integer = 0 To rh.n(0) -1 temp.arr(0) += lh.arr(i) * rh.arr(i) Next temp.n(0) = 1 temp.n(1) = 0 Case 2 '? "S 1" ReDim temp.arr( rh.n(0) -1) As Double '? "S 1", UBound( temp.arr)
For j As Integer = 0 To rh.n(0) -1 For i As Integer = 0 To rh.n(1) -1 ' temp.arr(j) += rh.arr(j + i * rh.n(0)) * lh.arr(i) '? temp.arr(j);" "; Next '? Next temp.n(0) = rh.n(0) temp.n(1) = 0 End Select
Return temp End Operator
Operator * (lhs As vectorArray, rhs As vectorArray) As vectorArray Dim As vectorArray temp Dim As vectorArray lh, rh
If UBound(lhs.n) >= 0 And UBound(rhs.n) >= 0 Then
If UBound(lhs.n) > UBound(rhs.n) Then ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs ElseIf UBound(lhs.n) < UBound(rhs.n) Then ReDim temp.arr( rhs.n(0) -1) As Double lh = lhs rh = rhs Else ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs EndIf Else Return temp EndIf
If rh.n(0) > 0 And rh.n(1) = 0 Then For i As Integer = 0 To rh.n(0) -1 temp.arr(i) = lh.arr(i) * rh.arr(i) Next temp.n(0) = rh.n(0) temp.n(1) = 0 ElseIf rh.n(0) >= 0 And rh.n(1) > 0 Then For j As Integer = 0 To rh.n(0) -1 ' 3 For i As Integer = 0 To rh.n(1) -1 ' temp.arr(j) *= rh.arr(j + i * rh.n(0)) * lh.arr(i) '? temp.arr(j);" "; Next '? Next temp.n(0) = rh.n(0) temp.n(1) = rh.n(1) Else ? "Array is empty" EndIf
Return temp End Operator
Operator / (lhs As vectorArray, rhs As vectorArray) As vectorArray Dim As vectorArray temp Dim As vectorArray lh, rh
If UBound(lhs.n) >= 0 And UBound(rhs.n) >= 0 Then
If UBound(lhs.n) > UBound(rhs.n) Then ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs ElseIf UBound(lhs.n) < UBound(rhs.n) Then ReDim temp.arr( rhs.n(0) -1) As Double lh = lhs rh = rhs Else ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs EndIf Else Return temp EndIf
If rh.n(0) > 0 And rh.n(1) = 0 Then For i As Integer = 0 To rh.n(0) -1 If rh.arr(i) = 0 Then temp.arr(i) = 0 Else temp.arr(i) = lh.arr(i) / rh.arr(i) EndIf Next temp.n(0) = rh.n(0) temp.n(1) = 0 ElseIf rh.n(0) >= 0 And rh.n(1) > 0 Then For j As Integer = 0 To rh.n(0) -1 For i As Integer = 0 To rh.n(1) -1 If lh.arr(i) = 0 Then temp.arr(j) = 0 Else If rh.arr(j + i * rh.n(0)) / lh.arr(i) = 0 Then temp.arr(j) = 0 Else temp.arr(j) /= rh.arr(j + i * rh.n(0)) / lh.arr(i) EndIf EndIf '? temp.arr(j);" "; Next '? Next temp.n(0) = rh.n(0) temp.n(1) = rh.n(1) Else ? "Array is empty" EndIf
Return temp End Operator
Operator + (lhs As vectorArray, rhs As vectorArray) As vectorArray Dim As vectorArray temp Dim As vectorArray lh, rh
If UBound(lhs.n) >= 0 And UBound(rhs.n) >= 0 Then
If UBound(lhs.n) > UBound(rhs.n) Then ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs ElseIf UBound(lhs.n) < UBound(rhs.n) Then ReDim temp.arr( rhs.n(0) -1) As Double lh = lhs rh = rhs Else ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs EndIf Else Return temp EndIf
If rh.n(0) > 0 And rh.n(1) = 0 Then For i As Integer = 0 To rh.n(0) -1 temp.arr(i) = lh.arr(i) + rh.arr(i) Next temp.n(0) = rh.n(0) temp.n(1) = 0 ElseIf rh.n(0) >= 0 And rh.n(1) > 0 Then For j As Integer = 0 To rh.n(0) -1 ' 3 For i As Integer = 0 To rh.n(1) -1 ' temp.arr(j) += rh.arr(j + i * rh.n(0)) + lh.arr(i) '? temp.arr(j);" "; Next '? Next temp.n(0) = rh.n(0) temp.n(1) = rh.n(1) Else ? "Array is empty" EndIf
Return temp End Operator
Operator - (lhs As vectorArray, rhs As vectorArray) As vectorArray Dim As vectorArray temp Dim As vectorArray lh, rh
If UBound(lhs.n) >= 0 And UBound(rhs.n) >= 0 Then
If UBound(lhs.n) > UBound(rhs.n) Then ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs ElseIf UBound(lhs.n) < UBound(rhs.n) Then '? "v 2" ReDim temp.arr( rhs.n(0) -1) As Double lh = lhs rh = rhs Else ReDim temp.arr( lhs.n(0) -1) As Double lh = rhs rh = lhs EndIf Else Return temp EndIf
If rh.n(0) > 0 And rh.n(1) = 0 Then For i As Integer = 0 To rh.n(0) -1 temp.arr(i) = lh.arr(i) - rh.arr(i) Next temp.n(0) = rh.n(0) temp.n(1) = 0 ElseIf rh.n(0) >= 0 And rh.n(1) > 0 Then For j As Integer = 0 To rh.n(0) -1 ' 3 For i As Integer = 0 To rh.n(1) -1 ' temp.arr(j) -= rh.arr(j + i * rh.n(0)) - lh.arr(i) '? temp.arr(j);" "; Next '? Next temp.n(0) = rh.n(0) temp.n(1) = rh.n(1) Else ? "Array is empty" EndIf
Return temp End Operator ']
'[ -- Declare -- Ar, rndArr, ArgMax Declare Function rndAr OverLoad( a As Integer) As vectorArray Declare Function rndAr OverLoad( a As Integer, a1 As Integer) As vectorArray Declare Function Ar OverLoad( a As Integer) As vectorArray Declare Function Ar OverLoad( a As Integer, a1 As Integer) As vectorArray Declare Function ArgMax OverLoad( a() As Double) As Integer Declare Function ArgMax OverLoad( a As vectorArray) As Integer '] '[ -- Metods -- Function ArgMax OverLoad( a() As Double) As Integer Dim As Integer ArgMax_ For i As Integer = 0 To UBound(a) ArgMax_ = max( a(i), ArgMax_) Next return ArgMax_ End Function
Function ArgMax OverLoad( a As vectorArray) As Integer Dim As Double ArgMax_ If a.n(0) > 0 And a.n(1) = 0 Then For i As Integer = 0 To UBound(a.arr) ArgMax_ = max( a.arr(i), ArgMax_) Next ElseIf a.n(0) > 0 And a.n(1) > 0 Then For j As Integer = 0 To a.n(0) -1 For i As Integer = 0 To a.n(1) -1 ArgMax_ = max( a.arr(j + i * a.n(0)), ArgMax_) Next Next EndIf
return Int(ArgMax_) End Function
Function Ar OverLoad( a As Integer) As vectorArray Dim As vectorArray temp ReDim temp.arr( a - 1) As Double ReDim temp.n(1) As Double temp.n(0) = a temp.n(1) = 0
Return temp End Function
Function Ar OverLoad( a As Integer, a1 As Integer) As vectorArray Dim As vectorArray temp, temp1 ReDim temp.arr( a * a1 -1) As Double ReDim temp.n(1) As Double temp.n(0) = a temp.n(1) = a1 Return temp End Function
Function rndAr OverLoad( a As Integer) As vectorArray Dim As vectorArray temp
ReDim temp.arr( a - 1) As Double ReDim temp.n(1) As Double temp.n(0) = a temp.n(1) = 0
For i As Integer = 0 To UBound(temp.arr) temp.arr(i) = range( -1,1) Next
Return temp End Function
Function rndAr OverLoad( a As Integer, a1 As Integer) As vectorArray Dim As vectorArray temp
ReDim temp.arr( a * a1 -1) As Double ReDim temp.n(1) As Double temp.n(0) = a temp.n(1) = a1
For i As Integer = 0 To UBound(temp.arr) temp.arr(i) = range( -1,1) Next Return temp End Function ']
End Namespace
Namespace np '[ -- Declare -- PPrinte, Copy, Relu, Sigmoid, Sigmoid_symetric Declare Sub PPrinte( a() As Double) Declare Sub Copy( lhs() As Double, rhs() As Double) Declare Function Relu OverLoad( a As Double) As Double Declare Function Sigmoid OverLoad( a As Double, b As boolean = false) As Double Declare Function Sigmoid_symetric OverLoad( a As Double, b As boolean = false) As Double '] '[ -- Metods --
'limit to 0... Function Relu OverLoad( a As Double) As Double Return max(a, 0) End Function
'soft limit to 0...+1 Function Sigmoid OverLoad( a As Double, b As boolean = false) As Double If b = True Then Return a * (1 - a) Else Return 1 / (1 + Exp(-a)) EndIf End Function
'soft limit to -1...+1 Function Sigmoid_symetric OverLoad( a As Double, b As boolean = false) As Double If b = True Then Return 2 * a * (1 - a) Else Return 2 / (1 + Exp(-a)) - 1 EndIf End Function
Sub PPrint( a() As Double) For i As Integer = 0 To UBound(a) -1 ? Format( a(i), "0.00000");", "; Next ? Format( a( UBound(a)), "0.00000") End Sub
Sub Copy( lhs() As Double, rhs() As Double) For i As Integer = 0 To UBound(rhs) lhs(i) = rhs(i) Next End Sub '] End Namespace
