A practical working ANN

BasicCoder2 · Post by **BasicCoder2** » Jun 20, 2018 21:37

I have never been able to code a real ANN that could learn something worthwhile using back propagation.
https://en.wikipedia.org/wiki/Backpropagation
http://www.neuronalesnetz.de/

However here is some code from the master programmer D.J.Peters, which I thought might be of interest given the recent posts on ANNs.
viewtopic.php?f=8&t=16657&p=146290
I cannot explain how use it or how it works).

Code: Select all

' BackPropagationNet.bi

#ifndef BackPropagationNet_BI
#define BackPropagationNet_BI
type BackPropagationNet
  public:
  declare constructor(LearnSteps as integer=30000, _
                      LearnRate  as single =0.3  , _
                      Momentum   as single =0.9)
  declare sub      InitWeights()
  declare sub      SetInputsAndTargets(n as integer)
  declare function Activation(x as single) as single
  declare sub      FeedForward()
  declare sub      LearnStep()
  declare sub      LearnLoop()
  declare sub      ClearInputs()
  as integer       Steps
  as single        Inputs(4),Outputs(4)
  
  private:
  declare sub      FeedBackward()
  'Inputs   , Targets
  as integer Net(59) = { _
  0,0,0,0,0 ,0,0,0,0,0, _
  1,0,0,0,0 ,1,0,0,0,0, _
  0,1,0,0,0 ,0,1,0,0,0, _
  0,0,1,0,0 ,0,0,1,0,0, _
  0,0,0,1,0 ,0,0,0,1,0, _
  0,0,0,0,1 ,0,0,0,0,1 }
  as single  Epsilon,Alpha
  as single  WeightsInput(4,4),WeightsHidden(4,4)
  as single  BiasHidden  (4)  ,BiasOut (4),Hidden(4)
  as single  DeltaHidden (4)  ,DeltaOut(4),Target(4)
end type
constructor BackPropagationNet(LearnSteps as integer=30000, _
                               LearnRate  as single =0.3  , _
                               Momentum   as single =0.9)
  Steps  =LearnSteps:Epsilon=LearnRate:Alpha=Momentum
end constructor
sub BackPropagationNet.SetInputsAndTargets(N as integer)
  dim as integer N10=N*10
  dim as integer N15=N10+5
  for i as integer= 0 to 4
    Inputs(i) = Net(N10+i)
    Target(i) = Net(N15+i)
  next
end sub
sub BackPropagationNet.InitWeights()
  for i as integer=0 to 4
    for j as integer=0 to 4
      WeightsInput (i,j)=rnd()*2 - 1
      WeightsHidden(i,j)=rnd()*2 - 1
    next
    BiasHidden(i) =rnd()*2 - 1
    BiasOut(i)    =rnd()*2 - 1
  next
end sub


function BackPropagationNet.Activation (x as single) as single
  return 1/(1+exp(-X))
end function

sub BackPropagationNet.FeedForward()
  dim as integer i=any,j=any
  dim as single aI=any,aH=any
  for i = 0 to 4
    aI=0':aH=0
    for j=0 to 4
      aI+=Inputs(j) * WeightsInput (i,j)
      'aH+=Hidden(j) * WeightsHidden(i,j)
    next
    Hidden(i)  = Activation(aI+BiasHidden(i))
    'Outputs(i) = Activation(aH+BiasOut(i)   )
  next
  for i = 0 to 4
    aH=0
    for j=0 to 4
      aH+=Hidden(j) * WeightsHidden(i,j)
    next
    Outputs(i) = Activation(aH+BiasOut(i)   )
  next
end sub

sub BackPropagationNet.FeedBackward()
  dim as integer i=any,j=any

  for i=0 to 4
    DeltaOut(i) = (Target(i)-Outputs(i)) * Outputs(i) * (1 - Outputs(i))
  next
  for i=0 to 4
    for j=0 to 4
      WeightsHidden(i,j)=WeightsHidden(i,j)+(Epsilon * DeltaOut(i) * Hidden(j))
    next
    BiasOut(i) = BiasOut(i) + (Epsilon * DeltaOut(i))
  next
  for i=0 to 4
    DeltaHidden(i) = 0
    for j=0 to 4
      DeltaHidden(i)=DeltaHidden(i) + (DeltaOut(j) * WeightsHidden(i,j))
    next
    DeltaOut(i) = DeltaOut(i) * Hidden(i) * (1 - Hidden(i))
  next
  for i=0 to 4
    for j=0 to 4
      WeightsInput(i,j)=WeightsInput(i,j) + (Epsilon * DeltaOut(i) * Inputs(j))
    next
    BiasOut(i) = BiasOut(i) + Epsilon * DeltaOut(i)
  next
end sub

sub BackPropagationNet.LearnStep()
  for i as integer =0 to 5
    SetInputsAndTargets(i)
    FeedForward()
    FeedBackward()
  next
end sub
sub BackPropagationNet.LearnLoop()
  InitWeights()
  for i as integer =1 to Steps
    for j as integer =0 to 5
      SetInputsAndTargets(j)
      FeedForward()
      FeedBackward()
    next
  next
end sub
sub BackPropagationNet.ClearInputs()
  for i as integer =0 to 4
    Inputs(i)=0
  next
end sub
#endif

And a demo using the code,

Code: Select all

' testBackProp.bas

#include "BackPropagationNet.bi"


const scr_w = 800
const scr_h = 600


type AI_LANDER
  
  enum ACTIONS
    _Ready
    _Learned
    _Flying
    _Landed
    _Crashed
  end enum
  declare constructor(xpos_init  as single, _
                      ypos_init  as single, _
                      angle_init as single)
  declare sub Control()
  declare sub Update()
  declare sub DrawIt()
  as BackPropagationNet Net
  as ACTIONS action
  as integer  xpos,  ypos, angle
  as single  x1,y1, x2,y2, x3,y3
end type
constructor AI_LANDER(xpos_init  as single, _
                      ypos_init  as single, _
                      angle_init as single)
  xpos=xpos_init:ypos=ypos_init:angle=angle_init
  Update()
end constructor
sub AI_LANDER.Control()
  ' calc control params
end sub
sub AI_LANDER.Update()
  x1=xPos+cos(angle+1.57)*25:y1=yPos+sin(angle+1.57)*25
  x2=xPos+cos(angle     )*10:y2=yPos+sin(angle     )*10
  x3=xPos+cos(angle+3.14)*10:y3=yPos+sin(angle+3.14)*10
end sub
sub AI_LANDER.DrawIt()
  pset  (x1,y1):line -(x2,y2)
  line -(x3,y3):line -(x1,y1)
end sub

Randomize Timer
const as single TRESHOLD=0.0005
dim as string   Key
dim as integer  Keycode
dim as single   Diff
dim as single   xZone=rnd*(scr_w\2)-(scr_w\4)
' Init Luna by random (xPos,yPos,Angle)
dim as AI_LANDER Luna = TYPE<AI_LANDER>(rnd*scr_w\2-scr_w\4    , _
                                        100+rnd*(scr_h-100), _
                                        0)

ScreenRes scr_w,scr_h
Window (-scr_w\2,0)-(scr_w\2,scr_h)
WindowTitle "[L]earn [R]eset [Q]uit"

While KeyCode<>asc("Q")
  
  ScreenLock
    ' clear gfx
    Line (-scr_w\2,scr_h)-(scr_w\2,0),0,BF
    ' landing zone
    line (xZone-30,2)-(xZone+30,0),10,BF
    Luna.Update()
    Luna.DrawIt()
  ScreenUnlock
  sleep 50
  Key=Inkey():keycode=Len(Key)
  if KeyCode then
    KeyCode=Asc(Ucase(Right(Key,1)))
    select case as const keycode
      case asc("L")
        if Luna.Action<>Luna._Learned then
          WindowTitle "Learning"
          Luna.Net.LearnLoop()
          Luna.Action=Luna._Learned
          sleep 100
          WindowTitle "[F]ly [Q]uit"
        end if
      case asc("F")
        if Luna.Action=Luna._Learned then
          Luna.Action=Luna._Flying
          WindowTitle "Flying [R]eset [Q]uit"
        end if
      case asc("R")
        Luna.xPos  = rnd*scr_w\2-scr_w\4
        Luna.yPos  = 100+rnd*(scr_h-100)
        Luna.Angle = 0 'rnd*2-1
        xZone=rnd*(scr_w\2)-(scr_w\4)
        Luna.Action=Luna._Ready
        WindowTitle "[L]earn [Q]uit"
    end select
  end if

  if Luna.Action=Luna._Flying then
    dim as integer moving=0
    Luna.yPos-=1
    Diff=xZone-Luna.xPos
    with Luna.Net
      .ClearInputs()
      if abs(Diff)>1 then
        if Diff<0 then 
          .Inputs(0)=1
        else
          .Inputs(1)=1
        end if
      end if
      if Luna.yPos<5 then
        Luna.Net.Inputs(2)=1
      end if
      ' call the neuron network
      .FeedForward()

      if .Activation(.Outputs(0))>0.65 then Luna.xPos-=1
      if .Activation(.Outputs(1))>0.65 then Luna.xPos+=1
      if .Activation(.Outputs(2))>0.65 then Luna.yPos+=1
    end with
  end if
wend

dafhi · Post by **dafhi** » Jun 21, 2018 4:31

thanks for that.

poking around

Code: Select all

#include "BackPropagationNet.bi"

#Ifndef floor '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#Define floor(x) (((x)*2.0-0.5)shr 1)
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
  #EndIf

type v3s
  as single         x,y,z
  declare operator  cast as ulong
  declare constructor (as single=0, as single=0, as single=0)
End Type
constructor.v3s(_x as single, _y as single, _z as single)
  x=_x: y=_y: z=_z
end constructor
operator v3s.cast as ulong
  return rgb( floor(255.999*x), floor(255.999*y), floor(255.999*z) )
End Operator


function clamp(in as single, hi as single=1, lo as single=0) as single
  if in < lo then return lo
  if in > hi then return hi
  return in
End Function

function hsv(h as single, s as single, v as single) as v3s
  h -= 6*int(h/6)
  var x = clamp(2 - h - 2*(h-3)*(h>3))
  var y = clamp(h +     2*(h-2)*(h>2))
  var z = clamp(h - 2 + 2*(h-4)*(h>4))
  var lo=@x, mi=@y, hi=@z
  if *lo > *mi then swap lo, mi
  if *mi > *hi then swap mi, hi
  if *lo > *hi then swap lo, hi
  *lo = v * (*hi - s * (*hi - *lo))
  *mi = v * (*hi - s * (*hi - *mi))
  *hi *= v
  return type(x,y,z)
End function

function modu(in as double, m as double=1) as double
  return in - m * floor(in / m)
End Function


const   TwoPi = 8*atn(1)

type iAngle
  as single         a, ia
  declare operator  cast as single
End Type
operator iAngle.cast as single
  a = modu(a, twopi)
  a += ia
  return a - ia
End Operator

sub reset_iangle_array(a() as iangle, inc as single = 1 / twopi)
  for i as long = 0 to ubound(a)
    a(i).a = 0
    a(i).ia = inc
  next
End Sub


sub Main
  
  var w = 800
  var h = 600, hm = h-1, hh = h/2

  screenres w,h,32, 2
  screenset 1,0
 
  var           u = 1
  
  dim as iAngle             a(u), animate
  dim as BackPropagationNet Net
  Net.Learnloop
 
  animate.ia = twopi / 500
  
  var y_scale = hh/2
 
  while inkey=""
    
    cls
    
    with Net
      
      reset_iangle_array a(), twopi / w
      
      dim as single angle = animate
      var cosa = cos(angle)
      var sina = sin(angle)
      
      for x as long = 0 to w-1
        
        .ClearInputs
        
        for i as long = 0 to u
          var s = i / (u+1)
          var phase_off = twopi * s - cosa * (i=0)
          .Inputs(i) = sin( a(i) + phase_off ) - sina * (i=0)
          var y = hm - (hh + y_scale * .Inputs(i))
          pset ( x, y ), hsv( s*6, 1, .5 )
        Next
       
        .FeedForward
       
        for i as long = 0 to u
          var y = hm - (hh + y_scale * .Activation(.Outputs(i)))
          pset ( x, y ), hsv( 6*i/(u+1), 1, 1 )
        next
      
      Next
    
    end with
    
    flip:  sleep 1
  
  wend

end sub

main

A practical working ANN

A practical working ANN

Re: A practical working ANN