Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > PureBasic

PureBasic Мощный кросс-платформенный язык среднего уровня на основе BASIC. Подходит для решения широкого круга задач.

Ответ
 
Опции темы
Старый 20.06.2018, 15:33   #1
Izunad
ПроЭктировщик
 
Аватар для Izunad
 
Регистрация: 02.06.2011
Адрес: Набережные Челны
Сообщений: 103
Написано 27 полезных сообщений
(для 91 пользователей)
Радость Пример нейронной сетки на PureBasic

EXE файл
Declare Visual()
Declare Summ()
Declare.f Activation(x.f) 
Declare Weight()
Declare ReSumm(Boolean)
Declare Obychalka()
Structure result
  result.f
  error.f
  weight_delta.f
EndStructure
Global Dim Layer_0.result(3)
Global Dim Layer_1.result(4)
Global Dim Layer_2.result(2)
Global Dim Layer_3.result(1)
Global Dim LayerW_1.f(3,4)
Global Dim LayerW_2.f(4,2)
Global Dim LayerW_3.f(2,1)
Global fix_min.f = 1
Global fix_max.f = 0
If OpenWindow(0, 0, 0, 700, 400, "NS", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CheckBoxGadget(0,5,90, 170,20,"пешеход намерен переходить",#PB_CheckBox_ThreeState)  
  CheckBoxGadget(1,5,190,170,20,"ПОЛИЦИЯ",#PB_CheckBox_ThreeState) 
  CheckBoxGadget(2,5,290,170,20,"зеленый светофор",#PB_CheckBox_ThreeState) 
  ButtonGadget(3,540,175,100,20,"УСТУПИТЬ")
  ButtonGadget(4,540,205,100,20,"НЕ УСТУПАТЬ")
  ButtonGadget(5,540,300,100,20,"ОБУЧЕНИЕ")
  TextGadget(6,340,330,300,20,"Задача: уступить пешеходу только при полиции", #PB_Text_Center)
  Weight()
  Summ()
  Visual()
  Repeat
    Select WaitWindowEvent(#True)
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Summ():Visual()
          Case 1
            Summ():Visual()
          Case 2
            Summ():Visual()
          Case 3
            ReSumm(1):Summ():Visual()
          Case 4
            ReSumm(0):Summ():Visual()
          Case 5
            Obychalka():Visual()
        EndSelect
      Case #PB_Event_CloseWindow
        Exit = #True
    EndSelect
  Until Exit
EndIf
Procedure.f Activation(result.f)
  result = 1/(1+Pow(3,-result))
  ProcedureReturn result
EndProcedure
Procedure Weight()
  For i = 0 To 3
    For index = 0 To 2
      LayerW_1(index,i) = i-1.5
    Next
  Next
  For i = 0 To 1
    For index = 0 To 3
      LayerW_2(index,i) = i-0.5
    Next
  Next
  For i = 0 To 0
    For index = 0 To 1
      LayerW_3(index,i) = 1
    Next
  Next
EndProcedure
Procedure Visual()
  If StartDrawing(WindowOutput(0))
    For X = 0 To 2
      For Y = 0 To 3
        If LayerW_1(X,Y)>0
          For i=0 To 20
            Line(200,100+X*100,100,Y*100-50-X*100+i,RGB(0,0,LayerW_1(X,Y)*255))
          Next
        Else
          For i=0 To 20
            Line(200,100+X*100,100,Y*100-50-X*100+i,-RGB(LayerW_1(X,Y)*255,0,0))
          Next
        EndIf
      Next
      Circle(200,100+X*100,25,RGB(0,0,0))
      Circle(200,100+X*100,20,RGB(Layer_0(X)\result*255,Layer_0(X)\result*255,Layer_0(X)\result*255))
    Next
    For X = 0 To 3
      For Y = 0 To 1
        If LayerW_2(X,Y)>0
          For i=0 To 20
            Line(300,50+X*100,100,Y*100+99-X*100+i,RGB(0,0,LayerW_2(X,Y)*255))
          Next
        Else
          For i=0 To 20
            Line(300,50+X*100,100,Y*100+99-X*100+i,-RGB(LayerW_2(X,Y)*255,0,0))
          Next
        EndIf
      Next
      Circle(300,50+X*100,25,RGB(0,0,0))
      Circle(300,50+X*100,20,RGB(Layer_1(X)\result*255,Layer_1(X)\result*255,Layer_1(X)\result*255))
    Next
    For X = 0 To 1
      For Y = 0 To 0
        If LayerW_3(X,Y)>0
          For i=0 To 20
            Line(400,150+X*100,100,Y*100+50-X*100+i,RGB(0,0,LayerW_3(X,Y)*255))
          Next
        Else
          For i=0 To 20
            Line(400,150+X*100,100,Y*100+50-X*100+i,-RGB(LayerW_3(X,Y)*255,0,0))
          Next
        EndIf
      Next
      Circle(400,150+X*100,25,RGB(0,0,0))
      Circle(400,150+X*100,20,RGB(Layer_2(X)\result*255,Layer_2(X)\result*255,Layer_2(X)\result*255))
    Next
    Circle(500,200,25,RGB(0,0,0))
    Circle(500,200,20,RGB(Layer_3(0)\result*255,Layer_3(0)\result*255,Layer_3(0)\result*255))
    StopDrawing()
  EndIf
EndProcedure
Procedure Obychalka()
  For i = 0 To 100000
    Fix = Random(7)
    Select Fix
      Case 0
        SetGadgetState(0,0)
        SetGadgetState(1,0)
        SetGadgetState(2,0)
        Summ():ReSumm(0)
      Case 1
        SetGadgetState(0,1)
        SetGadgetState(1,0)
        SetGadgetState(2,0)
        Summ():ReSumm(0)
      Case 2
        SetGadgetState(0,1)
        SetGadgetState(1,1)
        SetGadgetState(2,0) 
        Summ():ReSumm(1)
      Case 3
        SetGadgetState(0,1)
        SetGadgetState(1,1)
        SetGadgetState(2,1)
        Summ():ReSumm(0)
      Case 4
        SetGadgetState(0,0)
        SetGadgetState(1,1)
        SetGadgetState(2,1)
        Summ():ReSumm(0)
      Case 5
        SetGadgetState(0,0)
        SetGadgetState(1,0)
        SetGadgetState(2,1) 
        Summ():ReSumm(0)
      Case 6
        SetGadgetState(0,1)
        SetGadgetState(1,0)
        SetGadgetState(2,1)
        Summ():ReSumm(0)
      Case 7
        SetGadgetState(0,0)
        SetGadgetState(1,1)
        SetGadgetState(2,0)  
        Summ():ReSumm(0)
    EndSelect
  Next 
  SetGadgetState(0,0)
  SetGadgetState(1,0)
  SetGadgetState(2,0)
  Summ()
EndProcedure
Procedure Summ()
  For i = 0 To 2
    Layer_0(i)\result = GetGadgetState(i)
  Next
  For i = 0 To 3
    Layer_1(i)\result = 0
    For index = 0 To 2
      Layer_1(i)\result = Layer_1(i)\result + (LayerW_1(index,i)*Layer_0(index)\result)
    Next
    Layer_1(i)\result = Activation(Layer_1(i)\result)
  Next
  For i = 0 To 1
    Layer_2(i)\result = 0
    For index = 0 To 3
      Layer_2(i)\result = Layer_2(i)\result + (LayerW_2(index,i)*Layer_1(index)\result)
    Next
    Layer_2(i)\result = Activation(Layer_2(i)\result)
  Next
  For i = 0 To 0
    Layer_3(i)\result = 0
    For index = 0 To 1
      Layer_3(i)\result = Layer_3(i)\result + (LayerW_3(index,i)*Layer_2(index)\result)
    Next
    Layer_3(i)\result = Activation(Layer_3(i)\result)
    
  Next
EndProcedure
Procedure ReSumm(Boolean)
  Accuracy.f = 0.1
  For i = 0 To 0
    Layer_3(i)\error = Boolean - Layer_3(i)\result
    Layer_3(i)\weight_delta = Layer_3(i)\error * (Layer_3(i)\result * (1 - Layer_3(i)\result))
    For index = 0 To 1
      LayerW_3(index,i) = LayerW_3(index,i) + Layer_3(i)\weight_delta * Layer_2(index)\result*Accuracy
      Layer_2(index)\error = LayerW_3(index,i) * Layer_3(i)\weight_delta
    Next
  Next
  
  For i = 0 To 1
    Layer_2(i)\weight_delta = Layer_2(i)\error * (Layer_2(i)\result * (1 - Layer_2(i)\result))
    For index = 0 To 3
      LayerW_2(index,i) = LayerW_2(index,i) + Layer_2(i)\weight_delta * Layer_1(index)\result*Accuracy
      Layer_1(index)\error = LayerW_2(index,i) * Layer_2(i)\weight_delta 
    Next
  Next
  
  For i = 0 To 3
    Layer_1(i)\weight_delta = Layer_1(i)\error * (Layer_1(i)\result * (1 - Layer_1(i)\result))
    For index = 0 To 2
      LayerW_1(index,i) = LayerW_1(index,i) + Layer_1(i)\weight_delta * Layer_0(index)\result*Accuracy
    Next
  Next
EndProcedure
__________________
Хочешь изменить мир-начни с шейдера.
(Offline)
 
Ответить с цитированием
Эти 3 пользователя(ей) сказали Спасибо Izunad за это полезное сообщение:
DarkInside (03.05.2019), Evgen (20.07.2018), ultimzeus (09.09.2018)
Старый 20.07.2018, 23:06   #2
Evgen
Разработчик
 
Аватар для Evgen
 
Регистрация: 12.01.2011
Адрес: Moscow
Сообщений: 419
Написано 68 полезных сообщений
(для 100 пользователей)
Ответ: Пример нейронной сетки на PureBasic

Нейронные сети интересная тема.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Izunad (11.03.2019)
Старый 11.03.2019, 18:46   #3
Izunad
ПроЭктировщик
 
Аватар для Izunad
 
Регистрация: 02.06.2011
Адрес: Набережные Челны
Сообщений: 103
Написано 27 полезных сообщений
(для 91 пользователей)
Подмигивание Ответ: Пример нейронной сетки на PureBasic

Для тех кто изучает нейросеть возможно будет полезно.
Это более менее универсальная библиотека.
Есть возможность указать количество слоев, количество нейронов в каждом слое
Вводим данные в первый слой >>> получаем данные с последнего слоя
При обучении сети не указывается правильный ответ, то есть мы указываем только то устраивает нас результат или нет (данный момент можно переписать)

Это песочница, но буду развивать дальше.
Declare.f Activation(res.f)
Structure connection
  weight_delta.f
  weight.f
  result.f
EndStructure
Structure neuron
  error.f
  result.f
  List connection.connection()
EndStructure
Structure layer
  List neuron.neuron()
EndStructure
Global NewList layer.layer()
Procedure.f Activation(res.f)
  res = 1/(1+Pow(3,-res))
  ProcedureReturn res
EndProcedure
Procedure CreateLayer(count)
  If ListSize(layer()) > #False
    SelectElement(layer(),ListSize(layer())-#True)
    ForEach(layer()\neuron())
      For i = #True To count
        AddElement(layer()\neuron()\connection())
      Next
    Next
  EndIf
  AddElement(layer())
  For i = #True To count
    AddElement(layer()\neuron())
  Next
EndProcedure
Procedure Save(file$)
  WriteInteger(0,ListSize(layer()))
  ForEach layer()
    WriteInteger(0,ListSize(layer()\neuron()))
    ForEach layer()\neuron()
      WriteInteger(0,ListSize(layer()\neuron()\connection()))
      ForEach layer()\neuron()\connection()
        WriteFloat(0,layer()\neuron()\connection()\weight)
      Next
    Next
  Next
EndProcedure
Procedure Open(file$)
  If OpenFile(0,file$)
    layer_count = ReadInteger(0)
    For i = #True To layer_count
      AddElement(layer())
      neuron_count = ReadInteger(0)
      For in = #True To neuron_count
        AddElement(layer()\neuron())
        connection_count = ReadInteger(0)
        For ind = #True To connection_count
          AddElement(layer()\neuron()\connection())
          layer()\neuron()\connection()\weight = ReadFloat(0)
        Next
      Next
    Next
    CloseFile(0)
  EndIf
EndProcedure
Procedure Learning(error,learning_rate.f)
  For i = ListSize(layer()) - #True To #False Step -#True
    SelectElement(layer(),i)
    ForEach layer()\neuron()
      If i = ListSize(layer()) - #True
        If error = #True
          If layer()\neuron()\result >= 0.5
            layer()\neuron()\error = - layer()\neuron()\result
          Else
            layer()\neuron()\error = #True - layer()\neuron()\result
          EndIf
        Else
          If layer()\neuron()\result >= 0.5
            layer()\neuron()\error = #True - layer()\neuron()\result
          Else
            layer()\neuron()\error = - layer()\neuron()\result
          EndIf
        EndIf
      Else
        weight_delta_error.f = #False
        ForEach layer()\neuron()\connection()
          If weight_delta_error < layer()\neuron()\connection()\weight_delta
            weight_delta_error = layer()\neuron()\connection()\weight_delta
          EndIf
        Next
        layer()\neuron()\error = layer()\neuron()\result * weight_delta_error
      EndIf
      weight_delta.f = layer()\neuron()\error * layer()\neuron()\result * (#True - layer()\neuron()\result)
      If i>#False
        neuron_index = ListIndex(layer()\neuron())
        SelectElement(layer(),i-#True)
        ForEach layer()\neuron()
          SelectElement(layer()\neuron()\connection(),neuron_index)
          layer()\neuron()\connection()\weight_delta = weight_delta
          layer()\neuron()\connection()\weight = layer()\neuron()\connection()\weight - layer()\neuron()\result * weight_delta * learning_rate
        Next
        SelectElement(layer(),i)
        SelectElement(layer()\neuron(),neuron_index)
      EndIf
    Next
  Next 
EndProcedure
Procedure EnterValue(index,value.f)
  SelectElement(layer(),#False)
  SelectElement(layer()\neuron(),index): layer()\neuron()\result = value
EndProcedure
Procedure.f ReadValue(index)
  If index = #False
    ForEach layer()
      layer_index = ListIndex(layer())
      ForEach layer()\neuron()
        If layer_index > #False
          neuron_index = ListIndex(layer()\neuron())
          SelectElement(layer(),layer_index - #True)
          Summa = #False
          ForEach layer()\neuron()
            SelectElement(layer()\neuron()\connection(),neuron_index)
            Summa = Summa + layer()\neuron()\connection()\result
          Next
          SelectElement(layer(),layer_index)
          SelectElement(layer()\neuron(),neuron_index)
          layer()\neuron()\result = Activation(Summa)
        EndIf
        ForEach layer()\neuron()\connection()
          layer()\neuron()\connection()\result = layer()\neuron()\connection()\weight * layer()\neuron()\result
        Next
      Next     
    Next
  EndIf  
  SelectElement(layer(),ListSize(layer()) - #True)
  SelectElement(layer()\neuron(),index)
  ProcedureReturn layer()\neuron()\result
EndProcedure
;Создаем слои с указанным количеством нейронов 
;CreateLayer(3) первый слой с тремя нейронами
;CreateLayer(5) второй слой с пятью нейронами
;CreateLayer(2) третий слой с двумя нейронами

;Вносим входные данные следующим образом
;EnterValue(0,0.7) первый входной нейрон
;EnterValue(1,0.9) второй входной нейрон
;EnterValue(2,0.2) третий входной нейрон

;После получаем данные
;ReadValue(0) первый выходной нейрон 
;ReadValue(1) второй выходной нейрон

;Learning(#True,0.1) #True указывает сети наличие ошибки, 0.1 параметр (в диапазоне от 0.1 до 0.9) указывает насколько "сильно" сеть должна учесть ошибку

;Сохранить сеть в файл Save(file$)
;Открыть сеть из файл Open(file$)
__________________
Хочешь изменить мир-начни с шейдера.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
DarkInside (03.05.2019)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 18:24.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com