Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Artificial Backpropagation Neural Network

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Artificial Backpropagation Neural Network

    ' artificial backpropagation neural network
    '
    ' this code was triggered off by this link:
    ' http://www.powerbasic.com/support/pb...ad.php?t=30780
    '
    ' june 6, 2004: adjusted minor issues including a repaint problem.
    ' june 7, 2004: some minor improvements.
    ' june 16, 2004: added desired output and specification of values
    ' for colors - concerning neurons and connections (weights), respectively.

    '
    ' this program demonstrates the backpropagation method of
    ' training an artificial neural network.
    '
    ' artificial neural networks is a fascinating branch of computer
    ' science. many links on the internet provide an overview of the
    ' methods involved.
    '
    ' here are a few links:
    '
    ' http://www.generation5.org/content/2002/bp.asp
    ' http://www.geocities.com/neuralbug/neural_networks.htm
    ' http://www.willamette.edu/~gorr/clas...449/intro.html
    '
    ' this program illustrates how patterns may be recognized by a
    ' neural network after having been trained by repeated exposure
    ' to such patterns. the neural network provided is very simple
    ' and mainly serves to illustrate the method.
    '
    ' the inputs are simple bitmaps of ascii characters "0" - "9".
    ' each bitmap consists of 20 data points on a 4 x 5 grid. thus
    ' the number of inputs is 20. a constantly active "bias" input
    ' neuron is also included to facilitate learning.
    '
    ' the neural network has 21 "internal" or "hidden" neurons. one
    ' of these is a "bias" neuron. the internal neurons provides the
    ' basis for the "brain activity" to learn the patterns.
    ' the correct outputs to be learned for each of the 10 input
    ' patterns are represented by 10 output neurons - one for each
    ' input pattern: each of the ascii characters "0" - "9" are
    ' translated into one of ten output neuron being on. so an
    ' output of 100000000 = "0", 0100000000 ="1", 0010000000 = "2"
    ' and so on ... until 0000000001 = "9". the program never
    ' produces precise zeroes or ones, but rather close
    ' approximations to the real values. you may adapt the program
    ' to learn larger and more complex patterns, if you provide
    ' a suitable training set.
    '
    ' the program is not very fast because real time graphics is
    ' included to illustrate the learning process.
    '
    ' the program provides a color coding for neuronal activity -
    ' the sequence for increasing activity being: blue (minimal
    ' activity), blue-green, green (medium activity), yellow, orange,
    ' red (maximal activity).
    '
    ' training can also be performed slowly to illustrate the
    ' workings of the network. you may also pause training to look
    ' closer on the status at a given stage.
    '
    ' sometimes, you may experience that learning for one of the
    ' outputs becomes "stuck" in a local minimum. if this happens,
    ' initialize and start a new training.
    '
    ' good luck!
    '
    ' erik christensen ------- june 5, 2004 ------- e.chr@email.dk
    Code:
    #compile exe
    #register none
    #dim all
    '
    #include "win32api.inc"
    '
    global dialheight&, dialwidth&
    global memdc&, hbit&
    '
    sub defcolors(byref colour() as long)
        local i&, k& : k = 18
        data 255,0,0,    255,85,0,   255,128,0,  255,170,0,  255,212,0,  223,223,0
        data 149,223,0,  64,191,0,   0,159,0,    0,159,53,   0,159,106,  0,140,122
        data 0,128,128,  0,96,191,   0,64,191,   0,26,159,   0,0,159
        for i=1 to 51 step 3 : decr k : colour(k) = rgb(val(read$(i)),val(read$(i+1)),val(read$(i+2))) : next
    end sub
    '
    callback function dialcallback
        static inputs       as long
        static outputs      as long
        static trainslowly  as long
        static pause        as long
        static te!, te2!, tem&, tem2&, tem3&, tem4&, i&, j&, k&, l&, m&, n&, bitm&, sumdelta!
        static hb1&, hb2&, hb3&, hb4&, hb5&
        static i1&, i2&, stx&, sty&
        static hdc&, ps as paintstruct, hbrush&, hfont&, holdf&
        static rad&
        static x() as long, y() as long
        dim colour(17) as global long, pen(17) as global long, brush(17) as global long
        static pnt as pointapi
        dim lpsz as static asciiz * 255
        '
        inputs = 21  ' 20 input neurons  + one bias (constantly active) neuron
        outputs = 10 ' 10 output neurons
        '
        dim xi(inputs)  as static long, yi(inputs)  as static long
        dim xh(inputs)  as static long, yh(inputs)  as static long
        dim xo(outputs) as static long, yo(outputs) as static long
    
        dim weightj(inputs, inputs)      as static single
        dim weightk(inputs, outputs)     as static single
        dim netj(inputs)                 as static single ' holds the net values for each neuron
        dim netk(outputs)                as static single
        dim outj(inputs)                 as static single
        dim outk(outputs)                as static single
        dim deltaj(inputs)               as static single
        dim deltak(outputs)              as static single
        dim bitmp(outputs, inputs)       as static single ' bitmap pattern of each character in the training set
        dim targetchar(outputs)          as static string ' the ascii equivalent of each character bitmap
        dim targetneur(outputs, outputs) as static single ' the "coded" equivalent of the target
        '
        select case cbmsg
            case %wm_initdialog
                hdc = getdc(cbhndl)
                memdc = createcompatibledc(hdc)
                hbit = createcompatiblebitmap(hdc, dialwidth, dialheight*1.1)
                selectobject memdc, hbit
                hbrush = getstockobject(%black_brush)
                selectobject memdc, hbrush
                patblt memdc, 0, 0, dialwidth, dialheight*1.1, %patcopy
                releasedc cbhndl, hdc
                call defcolors(colour())
                for i = 1 to 17
                    brush(i) = createsolidbrush(colour(i))
                    pen(i) = createpen(%ps_solid, byval 0, colour(i))
                next
                hb1 = getdlgitem(cbhndl, 100)
                hb2 = getdlgitem(cbhndl, 110)
                hb3 = getdlgitem(cbhndl, 120)
                hb4 = getdlgitem(cbhndl, 125)
                hb5 = getdlgitem(cbhndl, 130)
                k = dialwidth / (inputs * 1.35)
                tem2 = k
                rad& = k * 0.36
                j = dialheight * 0.1
                l = dialwidth * 0.1
                m = dialheight * 0.5
                for i = 1 to inputs
                    xi(i) = l : yi(i) = j
                    xh(i) = l : yh(i) = m
                    l = l + k
                next
                l = dialwidth * 0.1 + inputs * 0.5 * k - outputs * 0.85 * k + k * 0.3
                tem3 = l  : tem4 = k * 85 / 50
                j = dialheight * 0.9
                for i = 1 to outputs
                    xo(i) = l : yo(i) = j
                    l = l + tem4
                next
                setbkcolor memdc, 0
                settextcolor memdc, rgb(196,196,196)
                lpsz = " input "
                textout memdc, 5, dialheight*0.08, lpsz, byval len(lpsz)
                lpsz = " hidden "
                textout memdc, 5, dialheight*0.46, lpsz, byval len(lpsz)
                lpsz = " layer   "
                textout memdc, 5, dialheight*0.50, lpsz, byval len(lpsz)
                lpsz = " output "
                textout memdc, 5, dialheight*0.88, lpsz, byval len(lpsz)
                lpsz = " desired output "
                textout memdc, 5, dialheight*0.993, lpsz, byval len(lpsz)
                lpsz = " activity "
                textout memdc, dialwidth * 0.868, dialheight*0.345, lpsz, byval len(lpsz)
                '
                hfont = createfont(-11,5,0,0,400,0,0,0,0,3,2,1,82,"arial")
                holdf = selectobject(memdc, hfont)
                '
                i = dialheight*0.4 : j = dialwidth * 0.93 : k =  dialwidth * .00625
                te! = 0.985!
                for l = 17 to 1 step -1
                    selectobject memdc, pen(l)
                    selectobject memdc, brush(l)
                    ellipse memdc, j-k, i-k, j+k, i+k
                    movetoex memdc, j - dialwidth * .06875, i, byval %null
                    lineto memdc, j - dialwidth * .0975, i
                    '
                    settextalign memdc, %ta_right
                    te2! = log(te!/(1!-te!))+.001!
                    lpsz = format$(te2!,"#.0")
                    textout memdc, j- dialwidth * .0375, i-0.014 * dialheight , lpsz, byval len(lpsz)
                    '
                    settextalign memdc, %ta_left
                    lpsz = format$(te!,"#.00")
                    textout memdc, j+ dialwidth * .015, i-0.014 * dialheight , lpsz, byval len(lpsz)
                    i = i + 0.022 * dialheight
                    te = te-0.97!/16!
                next
                selectobject memdc, holdf
                '
                gosub initnet
                '
            case %wm_paint
                '
                updatewindow hb1
                updatewindow hb2
                updatewindow hb3
                updatewindow hb4
                updatewindow hb5
                '
                if n = 0 then
                    hdc = beginpaint(cbhndl, ps)
                    bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                    endpaint cbhndl, ps
                    releasedc cbhndl, hdc
                    incr n
                    gosub trainnet
                    lpsz = " pass "+format$(n)
                    textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
                    if isfalse pause then
                        if istrue trainslowly then sleep 500
                        invalidaterect cbhndl,byval %null,byval %false
                    end if
                else
                    if isfalse pause then
                        incr n
                        lpsz = " pass "+format$(n)
                        textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
                        gosub trainnet
                        hdc = beginpaint(cbhndl, ps)
                        bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                        endpaint cbhndl, ps
                        releasedc cbhndl, hdc
                        if istrue trainslowly then sleep 500
                        invalidaterect cbhndl,byval %null,byval %false
                    end if
                end if
                function = 1
            case %wm_destroy
                postquitmessage 0
            case %wm_size, %wm_sizing, %wm_move, %wm_moving
                if n = 1 then n = 0
            case %wm_command
                select case cbctl
                    case 100 ' initialize network
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then gosub initnet
                    case 110 ' train network slowly
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            control enable cbhndl, 125
                            control set text cbhndl, 125, "&pause"
                            pause = 0 : trainslowly = 1 : invalidaterect cbhndl,byval %null,byval %false
                        end if
                    case 120 ' train network fast
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            control enable cbhndl, 125
                            control set text cbhndl, 125, "&pause"
                            pause = 0 : trainslowly = 0 : invalidaterect cbhndl,byval %null,byval %false
                        end if
                    case 125 ' toggle pause
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            pause = 1 - pause
                            if pause = 1 then
                                control set text cbhndl, 125, "&resume"
                            else
                                control set text cbhndl, 125, "&pause"
                            end if
                            invalidaterect cbhndl,byval %null,byval %false
                        end if
                    case 130 ' exit
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            dialog end cbhndl, 0
                        end if
                    case else
    
                end select
            case else
        end select
        exit function
        '
        initnet:
            n = 0  ' initialize counter
            randomize timer ' seed the random number generator
            for j = 1 to inputs ' initialize weights with value from -1.25 to 1.25
                for k = 1 to inputs
                    weightj(j, k) = rnd * 2.5! - 1.25! ' layer j
                next
            next
            for j = 1 to inputs ' also for weights in the k layer
                for k = 1 to outputs
                    weightk(j, k) = rnd * 2.5! - 1.25! ' and layer k
                next
            next
            '
            i = 0
            for j = 1 to outputs
                for k = 1 to inputs - 1
                    incr i
                    bitmp(j, k) = val(read$(i))
                next
                incr i : targetchar(j) = read$(i)
                for k = 1 to outputs
                    targetneur(j, k) = 0!
                next
                bitm = (asc(targetchar(j)) - 47)
                targetneur(j, bitm) = 1
                bitmp(j, inputs) = 1 ' this is the bias value - always one
            next
            '
            n = 1
            gosub trainnet
            lpsz = " pass "+format$(n)+"                  "
            textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
            n = 0 ' necessary adjustment
            pause = 1
            invalidaterect cbhndl,byval %null,byval %false
            control enable cbhndl, 110
            control enable cbhndl, 120
            control set text cbhndl, 125, "&pause"
            control disable cbhndl, 125
            '
            ' 4 x 5 bitmaps of the numerals 0 to 9
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    1, 0, 0, 1
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            ' "target" for this bitmap
            data    "0"
            '
            data    0, 1, 0, 0
            data    1, 1, 0, 0
            data    0, 1, 0, 0
            data    0, 1, 0, 0
            data    1, 1, 1, 0
            data    "1"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 0, 1, 0
            data    0, 1, 0, 0
            data    1, 1, 1, 1
            data    "2"
            '
            data    1, 1, 1, 0
            data    0, 0, 0, 1
            data    0, 1, 1, 0
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "3"
            '
            data    1, 0, 0, 0
            data    1, 0, 1, 0
            data    1, 1, 1, 1
            data    0, 0, 1, 0
            data    0, 0, 1, 0
            data    "4"
            '
            data    1, 1, 1, 1
            data    1, 0, 0, 0
            data    1, 1, 1, 0
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "5"
            '
            data    0, 1, 1, 1
            data    1, 0, 0, 0
            data    1, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    "6"
            '
            data    1, 1, 1, 1
            data    0, 0, 0, 1
            data    0, 0, 1, 0
            data    0, 1, 0, 0
            data    0, 1, 0, 0
            data    "7"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    "8"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 1
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "9"
            '
        return
        '
        '
        trainnet:
        ' the trainning loop starts here
            m = (n - 1) mod outputs + 1 ' pattern being presented - varies from 1 to outputs
            lpsz = " pattern "+format$(m)+"    "
            textout memdc, dialwidth *0.86 ,dialheight*0.09, lpsz, byval len(lpsz)
            ' draw current input pattern
            stx = dialwidth * 0.861 : sty = dialheight*0.15
            selectobject memdc, getstockobject(%black_pen)
            for i1 = 1 to 20 step 4
                for i2 = 0 to 3
                    if bitmp(m, i1 + i2) < 0.5 then
                        selectobject memdc, brush(1)
                    else
                        selectobject memdc, brush(17)
                    end if
                    rectangle memdc, stx + i2 * 16, sty + i1 * 4, stx + (i2+1) * 16, sty + (i1+4) * 4
                next
            next
            ' forward pass calculates the nets and outs for each neuron
            for k = 1 to inputs ' 20 input bits and a bias value
                netj(k) = 0!     ' clear the value from the prev pass
                for l = 1 to inputs
                    ' draw connections from input neurons to hidden neurons
                    te = bitmp(m, l) * weightj(l, k)
                    selectobject memdc, pen(fix(1.5 + 16 * (1! / (1! + exp(-te)))))
                    movetoex memdc, xi(l), yi(l), byval %null
                    lineto memdc, xh(k), yh(k)
                    ' summarize contributions to hidden neuron k
                    netj(k) = netj(k) + te
                next
                ' calculate resultant output from hidden neuron k
                outj(k) = 1! / (1! + exp(-netj(k))) ' non - linearity
            next
            ' draw input neurons
            for l = 1 to inputs
                lpsz = format$(bitmp(m, l))+"    "
                textout memdc, dialwidth * 0.095 + tem2 * (l-1) ,dialheight*0.04, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * bitmp(m, l))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xi(l) - rad, yi(l) - rad, xi(l) + rad, yi(l) + rad
            next
            outj(inputs) = 1! ' force the bias neuron to one
            '
            ' calculate nets and out for layer k (output layer)
            for k = 1 to outputs
                netk(k) = 0!  ' clear out the previous value
                for l = 1 to inputs
                    ' draw connections
                    te = outj(l) * weightk(l, k)
                    selectobject memdc, pen(fix(1.5 + 16 * (1! / (1! + exp(-te)))))
                    movetoex memdc, xh(l), yh(l), byval %null
                    lineto memdc, xo(k), yo(k)
                    ' summarize contributions to output neuron k
                    netk(k) = netk(k) + te
                next
                outk(k) = 1! / (1! + exp(-netk(k))) ' transfer function
                ' find the deltas for the output layer
                deltak(k) = outk(k) * (1! - outk(k)) * (targetneur(m, k) - outk(k))
            next
            ' draw hidden neurons
            for l = 1 to inputs
                tem = fix(1.5 + 16 * outj(l))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xh(l) - rad, yh(l) - rad, xh(l) + rad, yh(l) + rad
            next
            ' draw output neurons
            for k = 1 to outputs
                lpsz = format$(outk(k),"#.00")
                textout memdc, tem3 + tem4 * (k-1)-14 ,dialheight*0.93, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * outk(k))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xo(k) - rad, yo(k) - rad, xo(k) + rad, yo(k) + rad
            next
            ' draw correct output being trained for
            for k = 1 to outputs
                lpsz = format$(targetneur(m, k))
                textout memdc, tem3 + tem4 * (k-1)-4,dialheight*1.04, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * targetneur(m, k))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xo(k) - rad, yo(k) - rad + dialheight*0.11, xo(k) + rad, yo(k) + rad + dialheight*0.11
            next
            '
            ' reverse pass.. to adjust the weights
            for j = 1 to inputs
                sumdelta = 0! ' clear from previous pass
                for k = 1 to outputs
                    ' prepare for the hidden layer, first
                    sumdelta = sumdelta + deltak(k) * weightk(j, k)
                    ' then adjust the weights for the k layer
                    weightk(j, k) = weightk(j, k) + deltak(k) * outj(j)
                next
                ' now get the deltas for the hidden layer.
                deltaj(j) = outj(j) * (1! - outj(j)) * sumdelta
            next
            ' adjust the weights for the hidden layer.
            for k = 1 to inputs
                for j = 1 to inputs
                    weightj(j, k) = weightj(j, k) + deltaj(k) * bitmp(m, j)
                next
            next
            '
        return
        '
    end function
    '
    function pbmain
        local hform1&,rc as rect,i&,count&
        local x1&, y1&
        systemparametersinfo %spi_getworkarea,byval 0, byval varptr(rc),byval 0
        dialog new 0, "neural network demonstration",,,0,0,%ws_popup or %ds_modalframe or %ws_caption _
            or %ws_minimizebox or %ws_sysmenu or %ds_center or %ws_clipchildren, 0 to hform1&
        dialwidth = rc.nright-rc.nleft : dialheight = rc.nbottom-rc.ntop
        movewindow hform1&, rc.nleft, rc.ntop, dialwidth, dialheight, %true
        dialog pixels hform1&, dialwidth, dialheight to units x1, y1
        dialog set color hform1&, rgb(255,255,255),  rgb(0,0,0)
        dialheight = dialheight - 42 * dialheight / y1
        control add button, hform1&,  100,  "&initialize", x1*.83, y1-88, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1&,  110,  "train &slowly", x1*.83, y1-74, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  120,  "train &fast", x1*.83, y1-60, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  125,  "&pause", x1*.83, y1-46, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  130,  "e&xit", x1*.83, y1-32, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        dialog show modeless hform1&, call dialcallback
        do
            dialog doevents to count&
        loop until count&=0
        for i&=1 to 17 : deleteobject pen(i) : deleteobject brush(i) : next
        deletedc memdc : deleteobject hbit
    end function
    ------------------




    [this message has been edited by erik christensen (edited june 16, 2004).]

  • #2
    ' this version is improved in various aspects. for example it now uses the mat
    ' statement to improve speed somewhat - see this link:
    http://www.powerbasic.com/support/pb...ad.php?t=24266

    ' it also introduces a learning enhancement by providing a constant adjustment
    ' to prevent very small deltas. in addition to enhancing learning, the risk of becoming
    ' stuck in a local minimum is thereby reduced. the constant "enhance" is set to 0.10
    ' but you may well experiment with other values.

    ' best regards,
    '
    ' erik christensen ------- march 20, 2005
    Code:
    #compile exe
    #register none
    #dim all
    '
    #include "win32api.inc"
    '
    global dialheight&, dialwidth&
    global memdc&, hbit&
    '
    sub defcolors(byref colour() as long)
        local i&, k& : k = 18
        data 255,0,0,    255,85,0,   255,128,0,  255,170,0,  255,212,0,  223,223,0
        data 149,223,0,  64,191,0,   0,159,0,    0,159,53,   0,159,106,  0,140,122
        data 0,128,128,  0,96,191,   0,64,191,   0,26,159,   0,0,159
        for i=1 to 51 step 3 : decr k : colour(k) = rgb(val(read$(i)),val(read$(i+1)),val(read$(i+2))) : next
    end sub
    '
    sub coordinates(byref x() as long, y() as long, layer as long, nodes as long)
        local mid&,lft&,rgt&,stp&,sta&,j&,i&
        j = dialheight * (0.1+(layer-1)*0.4)
        mid& = dialwidth * 0.455
        lft& = mid& - dialwidth * (0.375-(layer-1)*0.03)
        rgt& = mid& + dialwidth * (0.375-(layer-1)*0.03)
        stp&= (rgt-lft) \ nodes
        if stp mod 2 = 1 then decr stp
        sta = mid& - ((nodes-1)\2) * stp& - (1-nodes mod 2) * stp&\2
        for i = 1 to nodes
            x(i) = sta : y(i) = j
            sta = sta + stp
        next
    end sub
    '
    callback function dialcallback
        static inputs       as long
        static hidden       as long
        static outputs      as long
        static trainslowly  as long
        static pause        as long
        static te!, te2!, tem&, i&, j&, k&, l&, m&, n&, bitm&, sumdelta!, ll!
        static hb1&, hb2&, hb3&, hb4&, hb5&
        static i1&, i2&, stx&, sty&
        static hdc&, ps as paintstruct, hbrush&, hfont&, holdf&
        static rad&, mid&
        static x() as long, y() as long
        dim colour(17) as global long, pen(17) as global long, brush(17) as global long
        static pnt as pointapi
        dim lpsz as static asciiz * 255
        static enhance as single
        static paintflag as long
        static txt as string
        '
        enhance = 0.10! ' adjustment to avoid very small deltas. this improves learning
        '               ' and reduces the risk of being stuck in local minima.
        '
        inputs = 21  ' 20 input neurons  + one bias (constantly active) neuron
        hidden = 12  ' 11 hidden neurons + one bias (constantly active) neuron
        outputs = 10 ' 10 output neurons
        '
        dim xi(inputs)  as static long, yi(inputs)  as static long
        dim xh(hidden)  as static long, yh(hidden)  as static long
        dim xo(outputs) as static long, yo(outputs) as static long
    
        dim weightj(1 to hidden, 1 to inputs)       as static single
        dim weightk(1 to outputs, 1 to hidden)      as static single
        dim netj(1 to hidden)                       as static single ' holds the net values for each neuron
        dim netk(1 to outputs)                      as static single
        dim outj(1 to hidden)                       as static single
        dim outk(1 to outputs)                      as static single
        dim deltaj(1 to hidden)                     as static single
        dim deltak(1 to outputs)                    as static single
        dim bitmp(1 to outputs, 1 to inputs)        as static single ' bitmap pattern of each character in the training set
        dim btt(1 to inputs)                        as static single ' current bitmap pattern
        dim targetchar(1 to outputs)                as static string ' the ascii equivalent of each character bitmap
        dim targetneur(1 to outputs, 1 to outputs)  as static single ' the "coded" equivalent of the target
        '
        select case cbmsg
            case %wm_initdialog
                hdc = getdc(cbhndl)
                memdc = createcompatibledc(hdc)
                hbit = createcompatiblebitmap(hdc, dialwidth, dialheight*1.1)
                selectobject memdc, hbit
                hbrush = getstockobject(%black_brush)
                selectobject memdc, hbrush
                patblt memdc, 0, 0, dialwidth, dialheight*1.1, %patcopy
                releasedc cbhndl, hdc
                call defcolors(colour())
                for i = 1 to 17
                    brush(i) = createsolidbrush(colour(i))
                    pen(i) = createpen(%ps_solid, byval 0, colour(i))
                next
                hb1 = getdlgitem(cbhndl, 100)
                hb2 = getdlgitem(cbhndl, 110)
                hb3 = getdlgitem(cbhndl, 120)
                hb4 = getdlgitem(cbhndl, 125)
                hb5 = getdlgitem(cbhndl, 130)
                '
                rad& = 0.36 * dialwidth / (inputs * 1.35)
                call coordinates(xi(), yi(), 1, inputs)
                call coordinates(xh(), yh(), 2, hidden)
                call coordinates(xo(), yo(), 3, outputs)
                '
                setbkcolor memdc, 0
                settextcolor memdc, rgb(196,196,196)
                lpsz = " input "
                textout memdc, 5, dialheight*0.08, lpsz, byval len(lpsz)
                lpsz = " hidden "
                textout memdc, 5, dialheight*0.46, lpsz, byval len(lpsz)
                lpsz = " layer   "
                textout memdc, 5, dialheight*0.50, lpsz, byval len(lpsz)
                lpsz = " output "
                textout memdc, 5, dialheight*0.88, lpsz, byval len(lpsz)
                lpsz = " desired output "
                textout memdc, 5, dialheight*0.993, lpsz, byval len(lpsz)
                lpsz = " activity "
                textout memdc, dialwidth * 0.868, dialheight*0.345, lpsz, byval len(lpsz)
                '
                hfont = createfont(-11,5,0,0,400,0,0,0,0,3,2,1,82,"arial")
                holdf = selectobject(memdc, hfont)
                '
                i = dialheight*0.4 : j = dialwidth * 0.93 : k =  dialwidth * .00625
                te! = 0.985!
                for l = 17 to 1 step -1
                    selectobject memdc, pen(l)
                    selectobject memdc, brush(l)
                    ellipse memdc, j-k, i-k, j+k, i+k
                    movetoex memdc, j - dialwidth * .06875, i, byval %null
                    lineto memdc, j - dialwidth * .0975, i
                    '
                    settextalign memdc, %ta_right
                    te2! = log(te!/(1!-te!))+.001!
                    lpsz = format$(te2!,"#.0")
                    textout memdc, j- dialwidth * .0375, i-0.014 * dialheight , lpsz, byval len(lpsz)
                    '
                    settextalign memdc, %ta_left
                    lpsz = format$(te!,"#.00")
                    textout memdc, j+ dialwidth * .015, i-0.014 * dialheight , lpsz, byval len(lpsz)
                    i = i + 0.022 * dialheight
                    te = te-0.97!/16!
                next
                selectobject memdc, holdf
                deleteobject hfont
                '
                gosub initnet
                paintflag = %true
                '
            case %wm_paint
                '
                updatewindow hb1
                updatewindow hb2
                updatewindow hb3
                updatewindow hb4
                updatewindow hb5
                '
                if istrue paintflag then
                    hdc = beginpaint(cbhndl, ps)
                    bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                    endpaint cbhndl, ps
                    gosub trainnet
                    lpsz = " pass "+format$(n,"#")+"      "
                    textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
                    if isfalse pause then
                        if istrue trainslowly then sleep 500
                        invalidaterect cbhndl,byval %null,byval %false
                    end if
                else
                    if isfalse pause then
                        incr n
                        lpsz = " pass "+format$(n,"#")+"      "
                        textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
                        gosub trainnet
                        hdc = beginpaint(cbhndl, ps)
                        bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                        endpaint cbhndl, ps
                        if istrue trainslowly then sleep 500
                        invalidaterect cbhndl,byval %null,byval %false
                    end if
                end if
                paintflag = %false
                function = 1
            case %wm_destroy
                postquitmessage 0
            case %wm_size, %wm_sizing, %wm_move, %wm_moving
                paintflag = %true
            case %wm_command
                select case cbctlmsg
                    case %bn_clicked, 1
                        select case cbctl
                            case 100 ' initialize network
                                gosub initnet : paintflag = %true
                            case 110 ' train network slowly
                                control enable cbhndl, 125
                                control set text cbhndl, 125, "&pause"
                                pause = 0 : trainslowly = 1 : invalidaterect cbhndl,byval %null,byval %false
                            case 120 ' train network fast
                                control enable cbhndl, 125
                                control set text cbhndl, 125, "&pause"
                                pause = 0 : trainslowly = 0 : invalidaterect cbhndl,byval %null,byval %false
                            case 125 ' toggle pause
                                pause = 1 - pause
                                if istrue pause then txt = "&resume" else txt = "&pause"
                                control set text cbhndl, 125, txt
                                invalidaterect cbhndl,byval %null,byval %false
                                updatewindow hb4
                            case 130 ' exit
                                dialog end cbhndl, 0
                            case else
                        end select
                    case else
                end select
            case else
        end select
        exit function
        '
        initnet:
            n = 0  ' initialize counter
            randomize timer ' seed the random number generator
            for j = 1 to inputs ' initialize weights with value from -1.25 to 1.25
                for k = 1 to hidden
                    weightj(k, j) = rnd * 2.5! - 1.25! ' layer j
                next
            next
            for j = 1 to hidden ' also for weights in the k layer
                for k = 1 to outputs
                    weightk(k, j) = rnd * 2.5! - 1.25! ' and layer k
                next
            next
            '
            i = 0
            for j = 1 to outputs
                for k = 1 to inputs - 1
                    incr i
                    bitmp(j, k) = val(read$(i))
                next
                incr i : targetchar(j) = read$(i)
                for k = 1 to outputs
                    targetneur(j, k) = 0!
                next
                bitm = (asc(targetchar(j)) - 47)
                targetneur(j, bitm) = 1!
                bitmp(j, inputs) = 1 ' this is the bias value - always one
            next
            '
            n = 1
            gosub trainnet
            lpsz = " pass "+format$(n,"#")+"      "
            textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, byval len(lpsz)
            pause = 1
            invalidaterect cbhndl,byval %null,byval %false
            control enable cbhndl, 110
            control enable cbhndl, 120
            control set text cbhndl, 125, "&pause"
            control disable cbhndl, 125
            '
            ' 4 x 5 bitmaps of the numerals 0 to 9
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    1, 0, 0, 1
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            ' "target" for this bitmap
            data    "0"
            '
            data    0, 1, 0, 0
            data    1, 1, 0, 0
            data    0, 1, 0, 0
            data    0, 1, 0, 0
            data    1, 1, 1, 0
            data    "1"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 0, 1, 0
            data    0, 1, 0, 0
            data    1, 1, 1, 1
            data    "2"
            '
            data    1, 1, 1, 0
            data    0, 0, 0, 1
            data    0, 1, 1, 0
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "3"
            '
            data    1, 0, 0, 0
            data    1, 0, 1, 0
            data    1, 1, 1, 1
            data    0, 0, 1, 0
            data    0, 0, 1, 0
            data    "4"
            '
            data    1, 1, 1, 1
            data    1, 0, 0, 0
            data    1, 1, 1, 0
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "5"
            '
            data    0, 1, 1, 1
            data    1, 0, 0, 0
            data    1, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    "6"
            '
            data    1, 1, 1, 1
            data    0, 0, 0, 1
            data    0, 0, 1, 0
            data    0, 1, 0, 0
            data    0, 1, 0, 0
            data    "7"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 0
            data    "8"
            '
            data    0, 1, 1, 0
            data    1, 0, 0, 1
            data    0, 1, 1, 1
            data    0, 0, 0, 1
            data    1, 1, 1, 0
            data    "9"
            '
        return
        '
        '
        trainnet:
        ' the trainning loop starts here
            m = (n - 1) mod outputs + 1 ' pattern being presented - varies from 1 to outputs
            lpsz = " pattern "+format$(m,"#")+"     "
            textout memdc, dialwidth *0.86 ,dialheight*0.09, lpsz, byval len(lpsz)
            ' draw current input pattern
            stx = dialwidth * 0.861 : sty = dialheight*0.15
            selectobject memdc, getstockobject(%black_pen)
            for i1 = 1 to 20 step 4
                for i2 = 0 to 3
                    selectobject memdc, brush(1 + fix(bitmp(m, i1 + i2) * 16 + 0.5))
                    rectangle memdc, stx + i2 * 16, sty + i1 * 4, stx + (i2+1) * 16, sty + (i1+4) * 4
                next
            next
            ' forward pass calculates the nets and outs for each neuron
            for k=1 to inputs : btt(k) = bitmp(m,k) : next ' transfer to current bitmap array
            mat netj() = weightj() * btt() ' calculate netj-array using mat statement
            '
            for k = 1 to hidden
                for l = 1 to inputs ' 20 input bits and a bias value
                    ' draw connections from input neurons to hidden neurons
                    te = btt(l) * weightj(k, l)
                    selectobject memdc, pen(fix(1.5 + 16 * (1! / (1! + exp(-te)))))
                    movetoex memdc, xi(l), yi(l), byval %null
                    lineto memdc, xh(k), yh(k)
                next
                ' calculate resultant output from hidden neuron k
                outj(k) = 1! / (1! + exp(-netj(k))) ' non - linearity
            next
            outj(hidden) = 1! ' force the bias neuron to one
            '
            ' draw input neurons
            for l = 1 to inputs
                lpsz = format$(bitmp(m, l),"#")+"    "
                textout memdc, xi(l)-5 ,dialheight*0.04, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * bitmp(m, l))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xi(l) - rad, yi(l) - rad, xi(l) + rad, yi(l) + rad
            next
            '
            ' calculate nets and out for layer k (output layer)
            ' calculate netk-array using mat statement
            mat netk() = weightk() * outj()
    
            for k = 1 to outputs
                for l = 1 to hidden
                    ' draw connections
                    te = outj(l) * weightk(k, l)
                    selectobject memdc, pen(fix(1.5 + 16 * (1! / (1! + exp(-te)))))
                    movetoex memdc, xh(l), yh(l), byval %null
                    lineto memdc, xo(k), yo(k)
                next
                outk(k) = 1! / (1! + exp(-netk(k))) ' transfer function
                ' find the deltas for the output layer
                deltak(k) = (outk(k) + enhance) * (1! - outk(k) + enhance) * (targetneur(m, k) - outk(k))
            next
            ' draw hidden neurons
            for l = 1 to hidden
                tem = fix(1.5 + 16 * outj(l))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xh(l) - rad, yh(l) - rad, xh(l) + rad, yh(l) + rad
            next
            ' draw output neurons
            for k = 1 to outputs
                lpsz = format$(outk(k),"#.00")
                textout memdc, xo(k)-15, dialheight*0.93, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * outk(k))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xo(k) - rad, yo(k) - rad, xo(k) + rad, yo(k) + rad
            next
            ' draw correct output being trained for
            for k = 1 to outputs
                lpsz = format$(targetneur(m, k),"#")
                textout memdc, xo(k)-4, dialheight*1.04, lpsz, byval len(lpsz)
                tem = fix(1.5 + 16 * targetneur(m, k))
                selectobject memdc, pen(tem)
                selectobject memdc, brush(tem)
                ellipse memdc, xo(k) - rad, yo(k) - rad + dialheight*0.11, xo(k) + rad, yo(k) + rad + dialheight*0.11
            next
            '
            if istrue paintflag then return ' if extra paint is needed just do that without adjusting the weights.
            ' reverse pass.. to adjust the weights
            for j = 1 to hidden
                sumdelta = 0! ' clear from previous pass
                for k = 1 to outputs
                    ' prepare for the hidden layer, first
                    sumdelta = sumdelta + deltak(k) * weightk(k, j)
                    ' then adjust the weights for the k layer
                    weightk(k, j) = weightk(k, j) + deltak(k) * outj(j)
                next
                ' now get the deltas for the hidden layer.
                deltaj(j) = (outj(j) + enhance) * (1! - outj(j) + enhance) * sumdelta
            next
            ' adjust the weights for the hidden layer.
            for k = 1 to hidden
                for j = 1 to inputs
                    weightj(k, j) = weightj(k, j) + deltaj(k) * bitmp(m, j)
                next
            next
            '
        return
        '
    end function
    '
    function pbmain
        local hform1&,rc as rect,i&,count&
        local x1&, y1&
        systemparametersinfo %spi_getworkarea,byval 0, byval varptr(rc),byval 0
        dialog new 0, "neural network demonstration",,,0,0,%ws_popup or %ds_modalframe or %ws_caption _
            or %ws_minimizebox or %ws_sysmenu or %ds_center or %ws_clipchildren, 0 to hform1&
        movewindow hform1&, rc.nleft, rc.ntop, rc.nright-rc.nleft, rc.nbottom-rc.ntop, %true
        getclientrect hform1&,rc
        dialheight = rc.nbottom : dialwidth = rc.nright
        dialog pixels hform1&, dialwidth, dialheight to units x1, y1
        dialog set color hform1&, rgb(255,255,255),  rgb(0,0,0)
        dialheight = dialheight - 30 * dialheight / y1
        control add button, hform1&,  100,  "&initialize", x1*.83, y1-88, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1&,  110,  "train &slowly", x1*.83, y1-74, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  120,  "train &fast", x1*.83, y1-60, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  125,  "&pause", x1*.83, y1-46, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1&,  130,  "e&xit", x1*.83, y1-32, x1*.15, 14, _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        dialog show modeless hform1&, call dialcallback
        do
            dialog doevents to count&
        loop until count&=0
        for i&=1 to 17 : deleteobject pen(i) : deleteobject brush(i) : next
        deletedc memdc : deleteobject hbit
    end function
    ------------------




    [this message has been edited by erik christensen (edited march 20, 2005).]

    Comment


    • #3
      This is a modification of Erik Christensen's program.
      Code:
       ' Changes include:
       ' *** Replaced the Pause button with a Step button.  (It acts as a
       '     pause button when "training slow" or "training fast".)
       ' *** Made node and net colors different, and the color variation linear.
       '     Net line colors range from blue to gray (the negative weights)
       '     then from gray to red (the positive).  That way you can see the sign
       '     of the weight, and know to subtract the blue nets from red nets
       '     going into a node.  However, by just looking it's still difficult
       '     to distinguish the net color shades well enough to tell if the sum
       '     is positive or negative, especially because the absolute value
       '     of the weights increases a lot near the extremes.  Even the sign
       '     of the sum is sometimes impossible to determine from the two colors
       '     when you have a large value minus a large value. (For example,
       '     if you have an equal number of bright reds and bright blues
       '     entering a node, the sum might be 40 - 20 which would be bright
       '     red, or 20 - 40 which would be bright blue.) So much for the net
       '     lines.  The color of a node, which indicates the Transfer function
       '     applied to the sum of the incoming net lines, varies from dark
       '     yellow to bright yellow.
       ' *** Increased the "fast" speed by printing fixed text only once,
       '     and having as little changing text as possible.
       ' *** Added a display for the success rate in the latest series of
       '     outputs.  An output is counted a success when the output node
       '     with the largest value (and which is unique in that regard)
       '     is the node specifying the input.
       ' *** Added a display for the variance of the successes in the last
       '     series of outputs.  This is defined as the average maximum of
       '     the non-maximum outputs in each pass.  As the iterations progress
       '     this variance goes to zero.
       ' *** Removed the array
       '        deltaj(hiddens)
       '     Though these values are computed they needn't be saved, each
       '     can be used in the loop in which it's computed.
       ' *** Removed the factor
       '        (outO(k) + ...)*(1 - outO(k) + ...)
       '     in the computation of
       '        deltaO(k)
       '     This speeds up convergence, though I don't understand the
       '     theoretical basis for it.
       ' *** Simplified the computation of targetneur(), now called target().
       '     It's simply the identity matrix.
       ' *** Replaced
       '        bitmap(m, q)
       '     with its equal (defined given m)
       '        pattern(q)
       '     in the adjustment.
       ' *** Replaced the arrays
       '        yi(), yh(), yo()
       '     with single variables
       '        yi, yh, ho
       ' *** Replaced the global array
       '        colour()
       '     with a single local variable
       '        colour
       ' *** Made the handle hbit local and deleted it right after use.
       ' *** Made constants:  inputs, hiddens, outputs.
       ' *** Removed displaying net lines going to the hidden bias node
       '     because they don't affect it.
       ' *** Made the code easier to follow and develop further by using
       '     constants, subroutines and macros; adding spaces in the algebra;
       '     renaming variables; making procedure names mixed case; etc.
       ' *** Culled API declarations for fast compiling.
       ' *** Reduced the number of middle ("hidden") nodes to 5 + 1, which is
       '     one more than the number necessary to distinguish the ten digit-
       '     patterns.
       ' *** Added an introduction in the comments.
       ' *** Not done: convert to PB graphic window.
       '---------------------------------------------------------------------------
      
       '                             Introduction
       '
       '      "The selection of the name 'neural network' was one of the
       '       great PR [public relations] successes of the Twentieth Century.
       '       It certainly sounds more exciting than ... 'A network of
       '       weighted, additive values with nonlinear transfer functions.'."
       '                                             -- Phillip Sherrod, DTREG
       '
       '  The "neural network" is the successor to the "perceptron" whose
       '  originator claimed it was based on the physiology of actual nerve
       '  neurons.  In fact it was based on an analogy with an incomplete and
       '  largely incorrect theory of neurons.  At the time the name "neural
       '  network" was pretentious, today it's a misnomer.
       '
       '  The biology of the nervous system is infinitely more complex than these
       '  mechanical "neural networks".  For details see the work and commentary
       '  of the neurophysiologist Jerome Letvin.
       '
       '  The conventional terminology is nonsensical.  Perceptrons which perceive
       '  nothing; pattern recognition, as the general field is sometimes called,
       '  in which nothing is recognized.
      
       '  Men design the machine, modeled or built, to sort input data (from a
       '  limited universe) into groups, after certain machine parameters have
       '  been determined by the user inputting lots of data sets along with what
       '  group each belongs to.  The iterative process is called "training",
       '  though it's as much training as the Newton-Raphson iterative method of
       '  finding the zero of a function.
       '
       '  Another quirk in the conventional terminology of these neural networks
       '  is that the middle node layer is called "hidden".  Hidden from whom,
       '  one might ask.  Finally, "pattern" is used in the sense of one of
       '  several inputs, for example the pixels of a picture, it is not used in
       '  the sense of a logical connection.
       '
       '  The conventional terminology is harmless enough if we keep in mind that
       '  it's whimsical and has no connection to biology.
       '
       '  ------------------------------------------------------------------------
      
       '  The neural network modeled below determines two matrices that can be
       '  used to determine which digit a four by five pixel grid or "pattern"
       '  represents.  These matrices operate on the input variables considered
       '  as a column matrix to determine a number of output variables.  The
       '  output variable with the highest value (ideally equal to one, the
       '  others ideally equal to zero) indicates one distribution of the input
       '  variables.
       '
       '  These two matrices are determined by an iterative process.  Known
       '  patterns (digits) are placed in the input, each coded as a sequence
       '  of 0s and 1s.  By comparing the output to what it should be, the
       '  matrix parameters (called weights) are modified, and the process
       '  is repeated.  With luck it converges.
       '
       '  Then you could use the matrices, now with fixed parameters, to classify
       '  future patterns, so long as they are among the original patterns.  The
       '  future patterns could even vary somewhat from the original ones and the
       '  functions might -- it doesn't always work -- classify them with the
       '  nearest original pattern.  (The program below doesn't test this.  It
       '  would be interesting to add manual pattern input.)
       '
       '  Trying to classify somewhat different patterns is the whole point of
       '  the enterprise.  If you knew that the input pattern exactly matched
       '  one of the standard patterns, it would be trivial to find which one
       '  by simply comparing its input array with that of each pattern in turn.
       '
       '  ------------------------------------------------------------------------
      
       '  Erik Christensen calls the two matrices:
       '     weightH(hiddens,inputs)
       '     weightO(outputs,hiddens)
       '  The input is a one column matrix of 0s and 1s:
       '     pattern(inputs)
       '  and the output is a one row matrix of numbers between 0 and 1:
       '     outO(outputs)
       '  Then
       '                      netH = weightH * pattern
       '                      outH = Transfer(netH)
       '                      netO = weightO * outH
       '                      outO = Transfer(netO)
       '  or simply
       '                      outH = Transfer(weightH * pattern)
       '                      outO = Transfer(weightO * outH)
       '
       '  where the asterisk indicates matrix multiplication and Transfer is a
       '  compacting function that operates on all elements of a column matrix,
       '  taking each entry, positive or not, and putting it in the range 0 to 1.
       '
       '  What the "training" -- the iterative process -- does is find the
       '  matrices  weightH()  and  weightO()  so that the above formula works.
       '  That is, if  pattern()  is the kth pattern then the kth entry of
       '  outO() is 1 (or nearly 1) and the other entries of  outO()  are 0
       '  (or nearly 0).
       '
       '  In practice you can stop the iterating long before  outO()  consists of
       '  0s and 1s and simply use the largest entry as the answer.  You can think
       '  of  outO()  as relative probabilities.
       '
       '  There are a lot of parameters: inputs*hiddens + hiddens*outputs, in this
       '  case  20*6 + 6*10  =  180.  It's no surprise a solution exists, the
       '  problem is finding it.
       '
       '  The fact that the input layer and "hidden" layer are arranged in a line
       '  might be seen as a restriction but it isn't.  Each node is connected to
       '  every other node (of adjacent layers), so how the nodes are arranged is
       '  immaterial.
       '
       '  To figure out the diagram the program draws, use the left column of the
       '  Color Key for the value of the network lines and sum them going into a
       '  node.  Then use the right column of the color key to determine the value
       '  and color of the node.  See however the second *** comment above.
       '
       '           Node color = color of Transfer(sum of net lines going in)
       '
       '  Note:  The way this is set up the number of outputs must equal the
       '         number of patterns.  It isn't suitable, directly, for
       '         classifying, for example, horizontal and vertical lines on
       '         a 4 x 5 grid.  In that case there are 4 + 5 = 9 patterns and
       '         2 (horizontal, vertical) outputs.  You could order the patterns,
       '         horizontal then vertical, then if the output number is less than
       '         5 it is horizontal, otherwise vertical.
       '---------------------------------------------------------------------------
      
       #Compile Exe
       #Dim All
       '---------------------------------------------------------------------------
      
      ' from win32api.inc
      
       %PS_SOLID = 0
       %BLACK_BRUSH = 4
       %PATCOPY = &H00F00021
       %SRCCOPY = &H00CC0020
       %SPI_GETWORKAREA = 48
      
       Type RECT
          nLeft As Long
          nTop As Long
          nRight As Long
          nBottom As Long
       End Type
      
       Type PAINTSTRUCT
          hDC As Dword
          fErase As Long
          rcPaint As RECT
          fRestore As Long
          fIncUpdate As Long
          rgbReserved(0 To 31) As Byte
       End Type
      
       Declare Function MoveToEx Lib "GDI32.DLL" Alias "MoveToEx" (ByVal hdc As Dword, ByVal x As Long, ByVal y As Long, lpPoint As PointAPI) As Long
       Declare Function LineTo Lib "GDI32.DLL" Alias "LineTo" (ByVal hDC As Dword, ByVal X As Long, ByVal Y As Long) As Long
       Declare Function Ellipse Lib "GDI32.DLL" Alias "Ellipse" (ByVal hdc As Dword, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
       Declare Function FillRect Lib "USER32.DLL" Alias "FillRect" (ByVal hDC As Dword, lpRect As RECT, ByVal hBrush As Dword) As Long
       Declare Function CreateSolidBrush Lib "GDI32.DLL" Alias "CreateSolidBrush" (ByVal crColor As Dword) As Dword
       Declare Function CreatePen Lib "GDI32.DLL" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Dword) As Dword
       Declare Function TextOut Lib "GDI32.DLL" Alias "TextOutA" (ByVal hdc As Dword, ByVal x As Long, ByVal y As Long, Asciiz, ByVal nCount As Long) As Long
       Declare Function GetDC Lib "USER32.DLL" Alias "GetDC" (ByVal hWnd As Dword) As Dword
       Declare Function CreateCompatibleDC Lib "GDI32.DLL" Alias "CreateCompatibleDC" (ByVal hdc As Dword) As Dword
       Declare Function DeleteDC Lib "GDI32.DLL" Alias "DeleteDC" (ByVal hdc As Dword) As Long
       Declare Function CreateCompatibleBitmap Lib "GDI32.DLL" Alias "CreateCompatibleBitmap" (ByVal hdc As Dword, ByVal nWidth As Long, ByVal nHeight As Long) As Dword
       Declare Function SelectObject Lib "GDI32.DLL" Alias "SelectObject" (ByVal hdc As Dword, ByVal hObject As Dword) As Dword
       Declare Function DeleteObject Lib "GDI32.DLL" Alias "DeleteObject" (ByVal hObject As Dword) As Long
       Declare Function GetStockObject Lib "GDI32.DLL" Alias "GetStockObject" (ByVal nIndex As Long) As Dword
       Declare Function PatBlt Lib "GDI32.DLL" Alias "PatBlt" (ByVal hdc As Dword, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Dword) As Long
       Declare Function ReleaseDC Lib "USER32.DLL" Alias "ReleaseDC" (ByVal hWnd As Dword, ByVal hDC As Dword) As Long
       Declare Function GetDlgItem Lib "USER32.DLL" Alias "GetDlgItem" (ByVal hDlg As Dword, ByVal nIDDlgItem As Long) As Dword
       Declare Function SetBkColor Lib "GDI32.DLL" Alias "SetBkColor" (ByVal hdc As Dword, ByVal crColor As Dword) As Dword
       Declare Function SetTextColor Lib "GDI32.DLL" Alias "SetTextColor" (ByVal hdc As Dword, ByVal crColor As Dword) As Dword
       Declare Function CreateFont Lib "GDI32.DLL" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, _
               ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
       Declare Function SetTextAlign Lib "GDI32.DLL" Alias "SetTextAlign" (ByVal hdc As Dword, ByVal dwFlags As Dword) As Dword
       Declare Function UpdateWindow Lib "USER32.DLL" Alias "UpdateWindow" (ByVal hWnd As Dword) As Long
       Declare Function BeginPaint Lib "USER32.DLL" Alias "BeginPaint" (ByVal hWnd As Dword, lpPaint As PAINTSTRUCT) As Long
       Declare Function EndPaint Lib "USER32.DLL" Alias "EndPaint" (ByVal hWnd As Dword, lpPaint As PAINTSTRUCT) As Long
       Declare Function BitBlt Lib "GDI32.DLL" Alias "BitBlt" (ByVal hDestDC As Dword, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
               ByVal nHeight As Long, ByVal hSrcDC As Dword, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Dword) As Long
       Declare Sub PostQuitMessage Lib "user32" Alias "PostQuitMessage" (ByVal nExitCode As Long)
       Declare Function InvalidateRect Lib "USER32.DLL" Alias "InvalidateRect" (ByVal hWnd As Dword, lpRect As RECT, ByVal bErase As Long) As Long
       Declare Function SystemParametersInfo Lib "USER32.DLL" Alias "SystemParametersInfoA" (ByVal uAction As Dword, ByVal uParam As Dword, lpvParam As Any, ByVal fuWinIni As Dword) As Long
       Declare Function MoveWindow Lib "USER32.DLL" Alias "MoveWindow" (ByVal hWnd As Dword, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
       Declare Function GetClientRect Lib "USER32.DLL" Alias "GetClientRect" (ByVal hwnd As Dword, lpRect As RECT) As Long
       '---------------------------------------------------------------------------
      
       Macro Transfer(x)    = 1/(1 + Exp(-x))   'Transfer(-infinity) = 0,  Transfer(0) = .5,  Transfer(infinity) = 1
       Macro TransferInv(x) = Log(x/(1 - x))    '0 < x < 1, inverse of Transfer
       Macro Arch(x)        = x*(1 - x)         '0 < x < 1,  Arch(0) = 0, Arch(.5) = .25.  Arch(1) = 0
       Macro MakeColorIndex(x) = Fix(1.5 + %ncolour1*x)     'Round(1 + ...)  0 <= x <= 1
       Macro DrawLine(x1,y1,x2,y2)
             MoveToEx winDC, x1,y1, ByVal 0
             LineTo winDC, x2,y2
       End Macro
       Macro SelectNetPen(x)    = SelectObject winDC, netpen(x)         'net lines
       Macro SelectNetBrush(x)  = SelectObject winDC, netbrush(x)
       Macro SelectNodePen(x)   = SelectObject winDC, nodepen(x)        'node spots or squares
       Macro SelectNodeBrush(x) = SelectObject winDC, nodebrush(x)
       Macro SelectUtensil(x)   = SelectObject winDC, x
      
       %dotsize  = 15
       %dotsizeI = 8
      
       ' 4 * 5 = 20 "pixels" in each pattern
       %inputs = 20 + 1       ' input nodes  + one bias (constantly active) node
       %hiddens = 5 + 1       ' hidden nodes + one bias (constantly active) node
       %outputs = 10          ' output nodes = number of patterns
      
       %ncolour = 21                      'must be odd
       %ncolour1 = %ncolour - 1
       %ncolourh = %ncolour\2
      
       %init = 100      'arbitrary labels for the buttons
       %slow = 110
       %fast = 120
       %step = 125
       %exit = 130
      
       %darkcolor    = &h004040
       %lightcolor   = &h00E0E0
       %midgraycolor = &h606060
       '---------------------------------------------------------------------------
      
       Global dialogheight, dialogwidth As Long
       Global dialogheight1 As Long
       Global stx, sty As Long
       Global winDC As Dword
       Global midgraypen As Long
       Global darkbrush, darkpen As Long
       Global lightbrush, lightpen As Long
       Global hform1 As Dword
      
       Global netpen(),   netbrush() As Long     'see PBMain
       Global nodepen(), nodebrush() As Long
       '---------------------------------------------------------------------------
      
       Sub DefineColors                          'called by %WM_InitDialog message
          Local k As Long
          Local e, f, rg, b, gb, r As Long
          Local colour As Long, x As Single
          'As pre transfer goes from -oo to 0 to +oo (post Transfer 0 to .5 to 1)
          'colors go from blue to dark gray to red.  Gray is RGB(80,80,80)
      
          '%ncolour is odd
          For k = 1 To %ncolourh + 1
             x = (k - 1)/%ncolourh
             b = 255*(1 - x) + 80*x
             rg = 80*x
             colour = RGB(rg, rg, b)
             netbrush(k) = CreateSolidBrush(colour)
             netpen(k) = CreatePen(%ps_solid, 0, colour)
          Next
          For k = %ncolourh + 1 To %ncolour
             x = (k - %ncolourh - 1)/%ncolourh
             r = 80*(1 - x) + 255*x
             gb = 80*(1 - x)
             colour = RGB(r, gb, gb)
             netbrush(k) = CreateSolidBrush(colour)
             netpen(k) = CreatePen(%ps_solid, 0, colour)
          Next
      
          '%darkcolor    = &h004040
          '%lightcolor   = &h00FFFF
          For k = 1 To %ncolour
             x = (k - 1)/%ncolour1
             rg = &h40*(1 - x) + &hFF*x
             colour = RGB(rg,rg,0)
             nodebrush(k) = CreateSolidBrush(colour)
             nodepen(k) = CreatePen(%ps_solid, 0, colour)
          Next
      
          'input colors
          darkbrush  = CreateSolidBrush(%darkcolor)
          lightbrush = CreateSolidBrush(%lightcolor)
          darkpen    = CreatePen(%ps_solid, 0, %darkcolor)
          lightpen   = CreatePen(%ps_solid, 0, %lightcolor)
          'general use: gray
          midgraypen = CreatePen(%ps_solid, 0, %midgraycolor)
       End Sub
       '---------------------------------------------------------------------------
      
       Sub DefineCoordinates(x() As Long, y As Long, layer As Long, nodes As Long)   'called by %WM_InitDialog message
          Local mid, lft, rgt, lr, stp, sta, i As Long
          mid = dialogwidth * .455
          lr =  dialogwidth * (.375 - (layer - 1)*.03)
          lft = mid - lr
          rgt = mid + lr
          stp = (lr\nodes)*2
          If layer = 2 Then         'make hidden layer narrower
             stp = stp*.6
          End If
          sta = mid - ((nodes - 1)\2) * stp - (1 - nodes Mod 2) * stp\2
          y = dialogheight * (.09 + (layer - 1) * .4)
          For i = 1 To nodes
             x(i) = sta + (i - 1)*stp
          Next
       End Sub
       '---------------------------------------------------------------------------
      
       Sub Printit(ByVal a As String, ByVal x As Single, ByVal y As Single, ByVal x1 As Single, ByVal y1 As Single)
          Local lpsz As Asciiz*255
          lpsz = a
          TextOut winDC, dialogwidth*x + x1, dialogheight*y + y1, lpsz, Len(lpsz)
       End Sub
       '---------------------------------------------------------------------------
      
       CallBack Function DialogCallback
          Static trainslow As Long           'flag
          Static pause     As Long           'flag
          Static stepit    As Long           'flag
          Static tem       As Long           'used for color index
          Static i, j, k, q As Long          'indices
          Static m As Long                   'current input pattern #
          Static n As Long                   'ditto but repeating (m is more less n mod %inputs)
          Static lastn As Long               'last used n
          Static hb1, hb2, hb3, hb4, hb5 As Dword   'button handles
          Static hDC, hfont, holdf As Dword         'font
          Static te, oh, t As Single         'intermediate values
          Static ps As PaintStruct
          Static rad As Long                 'radius of displayed node
          Static paintflag As Long           'flag
          Static txt As String
          Static outmax, outmaxindex As Long 'used to compute largest output node
          Static variance As Single
          Static successcount As Long        'number of successful %outputs in a pass
          Static v, y0 As Long               'intermediate values
          Static pdot As RECT
          Static hbit As Dword               'compatible bitmap handle
      
          Dim xi(%inputs)  As Static Long, yi As Static Long
          Dim xh(%hiddens) As Static Long, yh As Static Long
          Dim xo(%outputs) As Static Long, yo As Static Long
          ' used in Mat:  netH(), weightH(), netO(), weightO(), outH(), pattern()
          ' range and type must match.  The other arrays could begin at 0.
          Dim weightH(1 To %hiddens, 1 To %inputs)  As Static Single
          Dim weightO(1 To %outputs, 1 To %hiddens) As Static Single
          Dim pattern(1 To %inputs)                 As Static Single ' current bitmap pattern input
          Dim netH(1 To %hiddens)                   As Static Single ' netH = weightH * pattern
          Dim outH(1 To %hiddens)                   As Static Single ' outH = Transfer(netH)
          Dim netO(1 To %outputs)                   As Static Single ' netO = weightO * outH
          Dim outO(1 To %outputs)                   As Static Single ' outO = Transfer(netO)
          Dim sumdelta                              As Static Single ' (1 To %hiddens)
          Dim deltaO(1 To %outputs)                 As Static Single
          Dim deltaH                                As Static Single
          Dim bitmp(0 To %outputs, 1 To %inputs)    As Static Long   ' (%outputs) copies of bitmap pattern of %inputs (0 is for blank start when m = 0)
          Dim target(1 To %outputs, 1 To %outputs)  As Static Single ' identity matrix
          Dim othermax(1 To %outputs)               As Static Single
      
          Select Case CbMsg
          Case %WM_InitDialog
             hDC = GetDC(Cb.Hndl)
             winDC = CreateCompatibleDC(hDC)
             hbit = CreateCompatibleBitmap(hDC, dialogwidth, dialogheight1)
             SelectObject winDC, hbit
             DeleteObject hbit
             SelectObject winDC, GetStockObject(%black_brush)        ' window background
             PatBlt winDC, 0, 0, dialogwidth, dialogheight1, %patcopy
             ReleaseDC Cb.Hndl, hDC
             DefineColors
      
             hb1 = GetDlgItem(Cb.Hndl, %init)
             hb2 = GetDlgItem(Cb.Hndl, %slow)
             hb3 = GetDlgItem(Cb.Hndl, %fast)
             hb4 = GetDlgItem(Cb.Hndl, %step)
             hb5 = GetDlgItem(Cb.Hndl, %exit)
      
             Control Set Focus hform1, %slow
      
             rad = .36 * dialogwidth / (%inputs * 1.35)
             DefineCoordinates xi(), yi, 1, %inputs
             DefineCoordinates xh(), yh, 2, %hiddens
             DefineCoordinates xo(), yo, 3, %outputs
      
             SetBkColor winDC, 0
             SetTextColor winDC, RGB(196,196,196)
             Printit "Output", .02, .88-.01, 0, 0
             Printit "Input pattern", .02, 1.035-.01, 0, 0
             Printit "Passes:", .851, .04-.01, 0, 0
             Printit "Input pattern", .851, .084-.019, 0, 0
             For k = 1 To 10
                t = xo(k) - 4.25
                If k = 10 Then t = t - 3.1
                Printit Format$(k), 0, 1.025, t, 0
             Next
             Printit "Success", .02, .944-.025, 0, 0
      
             hfont = CreateFont(-11,5,0,0,400,0,0,0,0,3,2,1,82,"arial")
             holdf = SelectObject(winDC, hfont)
             printit "net           node", .866+.01, .347-.081+.03, 0, 0
      
             i = dialogheight * .4 - 37 + 3
             j = dialogwidth * .865
             k = dialogwidth * .00625
             For q = %ncolour To 1 Step -1
      '          SelectPen (q)
      '          SelectBrush (q)
      '          Ellipse winDC, j - k, i - k, j + k, i + k
                pdot.nTop    = i - k - 1
                pdot.nBottom = i + k - 1
                pdot.nLeft  = j - k
                pdot.nRight = j + k
                FillRect winDC, pdot, netbrush(q)
                te = (q-1) /%ncolour1
                If q = %ncolour Then
                 Printit "+o", .016,     -.0145, (j), (i)
                 Printit "o", .016+.013, -.0145,(j), (i)
                ElseIf q = 1 Then
                 Printit "-o", .016,     -.0145, (j), (i)
                 Printit "o",  .016+.01, -.0145, (j), (i)
                Else
                 Printit Format$(TransferInv(te),"+0.00;-0.00;  0.00"), .016, -.0145, (j), (i)
                End If
                Printit Format$(te,"0.00"), .065, -.0145, (j), (i)
      '          If q = %ncolourh + 1 Then
      '              Printit "-", -.011, -.018, (j), (i)
      '          End If
                pdot.nLeft  = j - k + 85
                pdot.nRight = j + k + 85
                FillRect winDC, pdot, nodebrush(q)
                i = i + dialogheight * .022
             Next
             Printit "x",   .78, .925-.008, 0, 0
             Printit ".01", .79, .925-.006, 0, 0
             SelectObject winDC, holdf
             DeleteObject hfont
      
             Printit "Color key", .866, .347-.075, 0, 0        'do after subtitle "net        node"
      
             'draw demarker for groups of four input nodes, each row of the 2D pattern
             SelectObject winDC, midgraypen
             y0 = yi - %dotsizeI -6
             For q = 1 To %inputs-1 Step 4
                DrawLine( xi(q)-7, y0, xi(q + 3)+7, y0 )
             Next
      
             paintflag = 1
      
             i = 0
             For j = 1 To %outputs
                For k = 1 To %inputs - 1
                   Incr i
                   bitmp(j, k) = Val(Read$(i))
                Next
                bitmp(j, %inputs) = 1              ' this is the bias value, always one
             Next
      
             Mat target() = Idn                    ' the identity matrix
      
             GoSub InitNet
      
          Case %WM_Paint
             UpdateWindow hb1                      ' must be done even when paintflag = 0
             UpdateWindow hb2
             UpdateWindow hb3
             UpdateWindow hb4
             UpdateWindow hb5
      
             If paintflag Then
                hDC = BeginPaint(Cb.Hndl, ps)
                BitBlt hDC, 0, 0, dialogwidth, dialogheight1, winDC, 0, 0, %srccopy
                EndPaint Cb.Hndl, ps
                paintflag = 0
             ElseIf stepit Or pause = 0 Then
                stepit = 0
                If n\%outputs <> lastn Then
                   Printit Format$(n\%outputs) + "     ", .93, .04-.01, 0, 0
                   lastn = n\%inputs
                End If
                Incr n
                GoSub TrainNet
                hDC = BeginPaint(Cb.Hndl, ps)
                BitBlt hDC, 0, 0, dialogwidth, dialogheight1, winDC, 0, 0, %srccopy
                EndPaint Cb.Hndl, ps
                If trainslow Then Sleep 100
                GoSub RefreshWindow
             End If
      
             Function = 1
      
          Case %WM_Destroy
             For i = 1 To %ncolour
                DeleteObject netpen(i)
                DeleteObject netbrush(i)
                DeleteObject nodepen(i)
                DeleteObject nodebrush(i)
             Next
             DeleteDC winDC
             PostQuitMessage 0
      
          Case  %WM_Size
             paintflag = 1
      
          Case %WM_Command
             If CbCtlMsg = %BN_Clicked Then
                Select Case CbCtl
                Case %init
                   Control Set Focus hform1, %init
                   GoSub InitNet
                   paintflag = 1
                Case %slow
                   Control Set Focus hform1, %step
                   pause = 0 : trainslow = 1
                   GoSub RefreshWindow
                Case %fast
                   Control Set Focus hform1, %step
                   pause = 0 : trainslow = 0
                   GoSub RefreshWindow
                Case %step
                   Control Set Focus hform1, %step
                   If pause = 1 Then
                      stepit = 1
                   Else
                      pause = 1
                   End If
                   GoSub RefreshWindow
                Case %exit
                   Dialog End Cb.Hndl, 0
                End Select
             End If
          End Select
      
          Exit Function
          '---------------------------------------------------------------
      
          RefreshWindow:
             InvalidateRect Cb.Hndl, ByVal 0, ByVal 0
          Return
      
          InitNet:
      '       tem = MakeColorIndex(0)
             For k = 1 To %outputs
      '          SelectNodePen(tem)       ' for edges/lines/boundary
      '          SelectNodeBrush(tem)     ' for filling inside
                SelectUtensil(darkpen)
                SelectUtensil(darkbrush)
                Ellipse winDC, xo(k) - rad, yo - rad + dialogheight*.11, xo(k) + rad, yo + rad + dialogheight*.11
             Next
      
             Printit "rate:            ", .02, .944, 0, 0
             Printit "?", .02+.046, .944, 0, 0
             Printit "variance:            ", .02, .944+.026, 0, 0
             Printit "?", .02+.085, .944+.026, 0, 0
      
             Randomize Timer                       ' seed the random number generator
             For j = 1 To %inputs                  ' initial weights vary randomly from -1 to 1
                For k = 1 To %hiddens
                   weightH(k, j) = Rnd * 2 - 1     ' (%hiddens,%inputs) operates on (%inputs)
                Next
             Next
             For j = 1 To %hiddens
                For k = 1 To %outputs
                   weightO(k, j) = Rnd * 2 - 1     ' (%outputs,%hiddens) operates on (%hiddens)
                Next
             Next
      
             n = 0                                 ' initialize passes counter
             lastn = -1
      
             Printit Format$(n,"#") + "      ", .93, .04-.01, 0 , 0
             pause = 1
             stepit = 1
             GoSub TrainNet
      
             ' 4 x 5 bitmaps for each pattern
             '----------------- 1st is 1
             Data  0, 1, 0, 0
             Data  1, 1, 0, 0
             Data  0, 1, 0, 0
             Data  0, 1, 0, 0
             Data  1, 1, 1, 0
             '----------------- 2nd is 2
             Data  0, 1, 1, 0
             Data  1, 0, 0, 1
             Data  0, 0, 1, 0
             Data  0, 1, 0, 0
             Data  1, 1, 1, 1
             '----------------- 3rd is 3
             Data  1, 1, 1, 0
             Data  0, 0, 0, 1
             Data  0, 1, 1, 0
             Data  0, 0, 0, 1
             Data  1, 1, 1, 0
             '----------------- 4th is 4
             Data  1, 0, 0, 0
             Data  1, 0, 1, 0
             Data  1, 1, 1, 1
             Data  0, 0, 1, 0
             Data  0, 0, 1, 0
             '----------------- 5th is 5
             Data  1, 1, 1, 1
             Data  1, 0, 0, 0
             Data  1, 1, 1, 0
             Data  0, 0, 0, 1
             Data  1, 1, 1, 0
             '----------------- 6th is 6
             Data  0, 1, 1, 0
             Data  1, 0, 0, 0
             Data  1, 1, 1, 0
             Data  1, 0, 0, 1
             Data  0, 1, 1, 0
             '----------------- 7th is 7
             Data  1, 1, 1, 1
             Data  0, 0, 0, 1
             Data  0, 0, 1, 0
             Data  0, 1, 0, 0
             Data  0, 1, 0, 0
             '----------------- 8th is 8
             Data  0, 1, 1, 0
             Data  1, 0, 0, 1
             Data  0, 1, 1, 0
             Data  1, 0, 0, 1
             Data  0, 1, 1, 0
             '----------------- 9th is 9
             Data  0, 1, 1, 0
             Data  1, 0, 0, 1
             Data  0, 1, 1, 1
             Data  0, 0, 0, 1
             Data  0, 1, 1, 0
             '----------------- 10th is 0
             Data  0, 1, 1, 0
             Data  1, 0, 0, 1
             Data  1, 0, 0, 1
             Data  1, 0, 0, 1
             Data  0, 1, 1, 0
          Return
          '---------------------------------------------------------------
      
          TrainNet:
             m = (n - 1) Mod %outputs + 1       ' pattern # being presented, from 1 to %outputs
             othermax(m) = 0
      
             If m = 1 Then successcount = 0 : variance = 0
      
             ' draw current input pattern
             For i = 0 To 5 - 1
                pdot.nTop    = sty + i*16
                pdot.nBottom = pdot.nTop + %dotsize
                For j = 0 To 4 - 1
                  pdot.nLeft  = stx + j*16
                  pdot.nRight = pdot.nLeft + %dotsize
                  If bitmp(m, i*4 + j + 1) Then
                    FillRect winDC, pdot, lightbrush
                  Else
                    FillRect winDC, pdot, darkbrush
                  End If
               Next
             Next
      
             ' calculate and draw the nets and outs for each node
             For k = 1 To %inputs               ' move to current bitmap array
                pattern(k) = bitmp(m,k)
             Next
             Mat netH() = weightH() * pattern()
      
             ' erase net from inactive input nodes
             SelectNetPen(MakeColorIndex(.5))   ' Transfer(0) = .5
             For k = 1 To %hiddens - 1          ' hidden but not bias
                For q = 1 To %inputs            ' input and bias
                   If pattern(q) = 0 Then
                      DrawLine( xi(q), yi, xh(k), yh )
                   End If
                Next
                ' calculate resultant output from hidden node k
                outH(k) = Transfer(netH(k))
             Next
             outH(%hiddens) = 1                 ' force the bias node to one
             ' draw connections from input nodes to %hiddens nodes
             For k = 1 To %hiddens - 1          ' hidden but not bias
                For q = 1 To %inputs            ' input and bias
                   If pattern(q) Then
                      te = Transfer(weightH(k, q) * pattern(q))
                      SelectNetPen(MakeColorIndex(te))
                      DrawLine( xi(q), yi, xh(k), yh )
                   End If
                Next
             Next
      
             ' draw input nodes
             pdot.nTop    = yi - %dotsizeI - 5
             pdot.nBottom = yi + %dotsizeI - 5
             For q = 1 To %inputs - 1
                pdot.nLeft  = xi(q) - %dotsizeI
                pdot.nRight = xi(q) + %dotsizeI
                If bitmp(m,q) Then
                   FillRect winDC, pdot, lightbrush
                Else
                   FillRect winDC, pdot, darkbrush
                End If
             Next
             ' here q = %inputs, input bias, always on, not in init as must cover net lines
             SelectObject winDC, lightpen
             SelectObject winDC, lightbrush
             Ellipse winDC, xi(q) - %dotsizeI, pdot.nTop, xi(q) + %dotsizeI, pdot.nBottom
      
             ' calculate net and outO for output layer
             Mat netO() = weightO() * outH()
      
             For k = 1 To %outputs
                For q = 1 To %hiddens
                   ' draw connections
                   te = Transfer(outH(q) * weightO(k, q))
                   SelectNetPen(MakeColorIndex(te))
                   DrawLine( xh(q), yh, xo(k), yo )
      '             printit format$(outH(q) * weightO(k, q)," #.#")+" ", (k-1)*.05 + (q-1)*.05, 0,0,0
                Next
                outO(k) = Transfer(netO(k))
                ' compute the deltas for the output layer
      
                deltaO(k) = target(m, k) - outO(k)         '*(outO(k)+.05)*(1-outO(k)+.05)
                'if k = m then
                ' deltaO(k) = 1 - outO(k)
                'else
                ' deltaO(k) =   - outO(k)
                'end if
             Next
      
             ' draw hidden nodes
             For k = 1 To %hiddens
                tem = MakeColorIndex(outH(k))
                SelectNodePen(tem)
                SelectNodeBrush(tem)
                Ellipse winDC, xh(k) - rad, yh - rad, xh(k) + rad, yh + rad
             Next
      
             ' draw output nodes
             outmax = -1
             outmaxindex = -1
             For k = 1 To %outputs
                v = outO(k)*100
                printit Format$(v,"* ###  ") , 0, .925-.01, xo(k)-20, 0
                tem = MakeColorIndex(outO(k))
                SelectNodePen(tem)
                SelectNodeBrush(tem)
                Ellipse winDC, xo(k) - rad, yo - rad, xo(k) + rad, yo + rad
                If v > outmax Then
                   outmax = v : outmaxindex = k
                End If
             Next
             If m > 0 Then
              For k = 1 To %outputs           'unique?
                 If k <> outmaxindex Then
                  If Val(Format$(outO(k)*100,"#")) = outmax Then Exit For
                 End If
              Next
              If k <= %outputs Then othermax(m) = -1
              If k > %outputs And outmaxindex = m Then
                 Incr successcount
                 For k = 1 To %outputs
                    If k <> outmaxindex Then
                       If outO(k) > othermax(m) Then othermax(m) = outO(k)
                    End If
                 Next
              Else
                 For k = 1 To %outputs
                    If outO(k) > othermax(m) Then othermax(m) = outO(k)
                 Next
              End If
              If m = %outputs Then
                 Printit Format$(successcount/%outputs,"0%") + "  ", .02+.046, .944, 0, 0
                 variance = 0
                 For k = 1 To %outputs
                    If othermax(k) < 0 Then Exit For
                    variance = variance + othermax(k)
                 Next
                 If k <= %outputs Then
                    txt = "?   "
                 Else
                    txt = Format$(variance*100/%outputs,"0.0")
                 End If
                 printit txt + "    ", .02+.085, .944+.026, 0, 0
              End If
             End If
      
             ' draw correct output
             If m > 0  Then
              If m = 1 Then
                 k = %outputs
              Else
                 k = m - 1
              End If
      '        tem = MakeColorIndex(0)
      '        SelectNodePen(tem)
      '        SelectNodeBrush(tem)
              SelectUtensil(darkpen)
              SelectUtensil(darkbrush)
              Ellipse winDC, xo(k) - rad, yo - rad + dialogheight * .11, xo(k) + rad, yo + rad + dialogheight * .11
              k = m
      '        tem = MakeColorIndex(1)
      '        SelectNodePen(tem)
      '        SelectNodeBrush(tem)
                SelectUtensil(lightpen)
                SelectUtensil(lightbrush)
              Ellipse winDC, xo(k) - rad, yo - rad + dialogheight * .11, xo(k) + rad, yo + rad + dialogheight * .11
             End If
      
             If paintflag Then Return     ' if extra paint is needed do that without adjusting weights.
      
             ' adjust the weights based on input pattern
             For j = 1 To %hiddens
                sumdelta = 0
                oh = outH(j)
                For k = 1 To %outputs
                   ' prepare for the hidden layer, first
                   sumdelta = sumdelta + deltaO(k) * weightO(k, j)
                   ' then adjust the weights for the output layer
                   weightO(k, j) = weightO(k, j) + deltaO(k) * oh
                Next
                ' compute delta for hidden layer
                deltaH = Arch(oh) * sumdelta          'was (oh + .05) * (1 - oh + .05) * sumdelta
                ' adjust weights for the hidden layer.
                For q = 1 To %inputs
                   weightH(j, q) = weightH(j, q) + deltaH * pattern(q)     'bitmp(m, q)
                Next
             Next
      
          Return
       End Function
       '---------------------------------------------------------------------------
      
       Function PBMain
          Dim netpen(%ncolour)    As Global Long
          Dim netbrush(%ncolour)  As Global Long
          Dim nodepen(%ncolour)   As Global Long
          Dim nodebrush(%ncolour) As Global Long
          Local rc As Rect
          Local w, h As Long
          SystemParametersInfo %spi_getworkarea, ByVal 0, ByVal VarPtr(rc), ByVal 0
          Dialog New 0, "",,,0,0,%WS_Popup Or %DS_ModalFrame Or %BS_Notify, 0 To hform1
          dialogwidth  = rc.nright  - rc.nleft
          dialogheight = rc.nbottom - rc.ntop
          MoveWindow hform1, rc.nleft, rc.ntop, dialogwidth, dialogheight, 1
          GetClientRect hform1, rc
          dialogheight1 = dialogheight*1.1
          stx = dialogwidth*.863 : sty = dialogheight*.097
          Dialog Pixels hform1, dialogwidth, dialogheight To Units w, h
          w = w*.861
          dialogheight = dialogheight * (1 - 30 / h)
          Control Add Button, hform1, %step, "S&tep",       w,h-88, 50,14
          Control Add Button, hform1, %slow, "Train &Slow", w,h-74, 50,14
          Control Add Button, hform1, %fast, "Train &Fast", w,h-60, 50,14
          Control Add Button, hform1, %init, "&Reset",      w,h-42, 50,14
          Control Add Button, hform1, %exit, "E&xit",       w,h-28, 50,14
          Dialog Show Modal hform1, Call DialogCallback
      '    Local nad As Long                 'message pump not necessary if Modal
      '    Do
      '       Dialog DoEvents 0 To nad
      '    Loop While nad
          Dialog End hform1
       End Function
      Last edited by Mark Hunter; 13 Jun 2010, 05:36 AM. Reason: improved colors
      Politically incorrect signatures about immigration patriots are forbidden. Googling “immigration patriots” is forbidden. Thinking about Googling ... well, don’t even think about it.

      Comment


      • #4
        Thanks for the prgrams Erik and Mark !
        Really good job . First time I can see the learning function in action !
        I wonder what happens if a network is trained for fi the figures 0 ...25 and then is given a value such as 26 or 27 .
        Will it give a good approximation ?
        I see the program uses a sigmoid function as transfer function .
        What would happen if one applies a linear function or quadratic function ? Any idea ?
        Last edited by Frank Kestens; 22 Jun 2010, 05:47 PM.

        Comment


        • #5
          For discussion see:
          http://www.powerbasic.com/support/pb...ad.php?t=30780
          Last edited by Mark Hunter; 24 Jun 2010, 06:39 PM.
          Politically incorrect signatures about immigration patriots are forbidden. Googling “immigration patriots” is forbidden. Thinking about Googling ... well, don’t even think about it.

          Comment


          • #6
            Here is an update of my code, which also works with PBWin10.

            Best regards,

            Erik

            Code:
            #COMPILE EXE
            #REGISTER NONE
            #DIM ALL
            '
            #INCLUDE "win32api.inc"
            '
            GLOBAL dialheight&, dialwidth&
            GLOBAL memdc&, hbit&
            '
            SUB defcolors(BYREF colour() AS LONG)
                LOCAL i&, k& : k = 18
                DATA 255,0,0,    255,85,0,   255,128,0,  255,170,0,  255,212,0,  223,223,0
                DATA 149,223,0,  64,191,0,   0,159,0,    0,159,53,   0,159,106,  0,140,122
                DATA 0,128,128,  0,96,191,   0,64,191,   0,26,159,   0,0,159
                FOR i=1 TO 51 STEP 3 : DECR k : colour(k) = RGB(VAL(READ$(i)),VAL(READ$(i+1)),VAL(READ$(i+2))) : NEXT
            END SUB
            '
            SUB coordinates(BYREF x() AS LONG, y() AS LONG, layer AS LONG, nodes AS LONG)
                LOCAL mid&,lft&,rgt&,stp&,sta&,j&,i&
                j = dialheight * (0.1+(layer-1)*0.4)
                mid& = dialwidth * 0.455
                lft& = mid& - dialwidth * (0.375-(layer-1)*0.03)
                rgt& = mid& + dialwidth * (0.375-(layer-1)*0.03)
                stp&= (rgt-lft) \ nodes
                IF stp MOD 2 = 1 THEN DECR stp
                sta = mid& - ((nodes-1)\2) * stp& - (1-nodes MOD 2) * stp&\2
                FOR i = 1 TO nodes
                    x(i) = sta : y(i) = j
                    sta = sta + stp
                NEXT
            END SUB
            '
            CALLBACK FUNCTION dialcallback
                STATIC inputs       AS LONG
                STATIC hiddens       AS LONG
                STATIC outputs      AS LONG
                STATIC trainslowly  AS LONG
                STATIC pause        AS LONG
                STATIC te!, te2!, tem&, i&, j&, k&, l&, m&, n&, bitm&, sumdelta!, ll!
                STATIC hb1&, hb2&, hb3&, hb4&, hb5&
                STATIC i1&, i2&, stx&, sty&
                STATIC hdc&, ps AS paintstruct, hbrush&, hfont&, holdf&
                STATIC rad&, mid&
                STATIC x() AS LONG, y() AS LONG
                DIM colour(17) AS GLOBAL LONG, pen(17) AS GLOBAL LONG, brush(17) AS GLOBAL LONG
                STATIC pnt AS POINTAPI
                DIM lpsz AS STATIC ASCIIZ * 255
                STATIC enhance AS SINGLE
                STATIC paintflag AS LONG
                STATIC txt1 AS STRING
                '
                enhance = 0.10! ' adjustment to avoid very small deltas. this improves learning
                '               ' and reduces the risk of being stuck in local minima.
                '
                inputs = 21  ' 20 input neurons  + one bias (constantly active) neuron
                hiddens = 12  ' 11 hidden neurons + one bias (constantly active) neuron
                outputs = 10 ' 10 output neurons
                '
                DIM xi(inputs)   AS STATIC LONG, yi(inputs)  AS STATIC LONG
                DIM xh(hiddens)  AS STATIC LONG, yh(hiddens) AS STATIC LONG
                DIM xo(outputs)  AS STATIC LONG, yo(outputs) AS STATIC LONG
            
                DIM weightj(1 TO hiddens, 1 TO inputs)       AS STATIC SINGLE
                DIM weightk(1 TO outputs, 1 TO hiddens)      AS STATIC SINGLE
                DIM netj(1 TO hiddens)                       AS STATIC SINGLE ' holds the net values for each neuron
                DIM netk(1 TO outputs)                       AS STATIC SINGLE
                DIM outj(1 TO hiddens)                       AS STATIC SINGLE
                DIM outk(1 TO outputs)                       AS STATIC SINGLE
                DIM deltaj(1 TO hiddens)                     AS STATIC SINGLE
                DIM deltak(1 TO outputs)                     AS STATIC SINGLE
                DIM bitmp(1 TO outputs, 1 TO inputs)         AS STATIC SINGLE ' bitmap pattern of each character in the training set
                DIM btt(1 TO inputs)                         AS STATIC SINGLE ' current bitmap pattern
                DIM targetchar(1 TO outputs)                 AS STATIC STRING ' the ascii equivalent of each character bitmap
                DIM targetneur(1 TO outputs, 1 TO outputs)   AS STATIC SINGLE ' the "coded" equivalent of the target
                '
                SELECT CASE CBMSG
                    CASE %WM_INITDIALOG
                        hdc = getdc(CBHNDL)
                        memdc = createcompatibledc(hdc)
                        hbit = createcompatiblebitmap(hdc, dialwidth, dialheight*1.1)
                        selectobject memdc, hbit
                        hbrush = getstockobject(%black_brush)
                        selectobject memdc, hbrush
                        patblt memdc, 0, 0, dialwidth, dialheight*1.1, %patcopy
                        releasedc CBHNDL, hdc
                        CALL defcolors(colour())
                        FOR i = 1 TO 17
                            brush(i) = createsolidbrush(colour(i))
                            pen(i) = createpen(%ps_solid, BYVAL 0, colour(i))
                        NEXT
                        hb1 = getdlgitem(CBHNDL, 100)
                        hb2 = getdlgitem(CBHNDL, 110)
                        hb3 = getdlgitem(CBHNDL, 120)
                        hb4 = getdlgitem(CBHNDL, 125)
                        hb5 = getdlgitem(CBHNDL, 130)
                        '
                        rad& = 0.36 * dialwidth / (inputs * 1.35)
                        CALL coordinates(xi(), yi(), 1, inputs)
                        CALL coordinates(xh(), yh(), 2, hiddens)
                        CALL coordinates(xo(), yo(), 3, outputs)
                        '
                        setbkcolor memdc, 0
                        settextcolor memdc, RGB(196,196,196)
                        lpsz = " input "
                        textout memdc, 5, dialheight*0.08, lpsz, BYVAL LEN(lpsz)
                        lpsz = " hidden "
                        textout memdc, 5, dialheight*0.46, lpsz, BYVAL LEN(lpsz)
                        lpsz = " layer   "
                        textout memdc, 5, dialheight*0.50, lpsz, BYVAL LEN(lpsz)
                        lpsz = " output "
                        textout memdc, 5, dialheight*0.88, lpsz, BYVAL LEN(lpsz)
                        lpsz = " desired output "
                        textout memdc, 5, dialheight*0.993, lpsz, BYVAL LEN(lpsz)
                        lpsz = " activity "
                        textout memdc, dialwidth * 0.877, dialheight*0.345, lpsz, BYVAL LEN(lpsz)
                        '
                        hfont = createfont(-10,5,0,0,400,0,0,0,0,3,2,1,82,"arial")
                        holdf = selectobject(memdc, hfont)
                        '
                        i = dialheight*0.40 : j = dialwidth * 0.93 : k =  dialwidth * .00525
                        te! = 0.985!
                        FOR l = 17 TO 1 STEP -1
                            selectobject memdc, pen(l)
                            selectobject memdc, brush(l)
                            ELLIPSE memdc, j-k, i-k, j+k, i+k
                            movetoex memdc, j - dialwidth * .06875, i, BYVAL %null
                            lineto memdc, j - dialwidth * .0975, i
                            '
                            settextalign memdc, %ta_right
                            te2! = LOG(te!/(1!-te!))+.001!
                            lpsz = FORMAT$(te2!,"#.0")
                            textout memdc, j- dialwidth * .0475, i - 0.01* dialheight , lpsz, BYVAL LEN(lpsz)  ' -0.014
                            '
                            settextalign memdc, %ta_left
                            lpsz = FORMAT$(te!,"#.00")
                            textout memdc, j+ dialwidth * .015, i - 0.01 * dialheight , lpsz, BYVAL LEN(lpsz)
                            i = i + 0.022 * dialheight
                            te = te-0.97!/16!
                        NEXT
                        selectobject memdc, holdf
                        deleteobject hfont
                        '
                        GOSUB initnet
                        paintflag = %true
                        '
                    CASE %WM_PAINT
                        '
                        updatewindow hb1
                        updatewindow hb2
                        updatewindow hb3
                        updatewindow hb4
                        updatewindow hb5
                        '
                        IF ISTRUE paintflag THEN
                            hdc = beginpaint(CBHNDL, ps)
                            bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                            endpaint CBHNDL, ps
                            GOSUB trainnet
                            lpsz = " pass "+FORMAT$(n,"#")+"      "
                            textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, BYVAL LEN(lpsz)
                            IF ISFALSE pause THEN
                                IF ISTRUE trainslowly THEN SLEEP 500
                                invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                            END IF
                        ELSE
                            IF ISFALSE pause THEN
                                INCR n
                                lpsz = " pass "+FORMAT$(n,"#")+"      "
                                textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, BYVAL LEN(lpsz)
                                GOSUB trainnet
                                hdc = beginpaint(CBHNDL, ps)
                                bitblt hdc, 0, 0, dialwidth, dialheight*1.1, memdc, 0, 0, %srccopy
                                endpaint CBHNDL, ps
                                IF ISTRUE trainslowly THEN SLEEP 500
                                invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                            END IF
                        END IF
                        paintflag = %false
                        FUNCTION = 1
                    CASE %WM_DESTROY
                        postquitmessage 0
                    CASE %WM_SIZE, %WM_MOVE
                        paintflag = %true
                        invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                    CASE %WM_COMMAND
                        SELECT CASE CBCTLMSG
                            CASE %BN_CLICKED, 1
                                SELECT CASE CBCTL
                                    CASE 100 ' initialize network
                                        GOSUB initnet : paintflag = %true
                                    CASE 110 ' train network slowly
                                        CONTROL ENABLE CBHNDL, 125
                                        CONTROL SET TEXT CBHNDL, 125, "&pause"
                                        pause = 0 : trainslowly = 1 : invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                                    CASE 120 ' train network fast
                                        CONTROL ENABLE CBHNDL, 125
                                        CONTROL SET TEXT CBHNDL, 125, "&pause"
                                        pause = 0 : trainslowly = 0 : invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                                    CASE 125 ' toggle pause
                                        pause = 1 - pause
                                        IF ISTRUE pause THEN txt1 = "&resume" ELSE txt1 = "&pause"
                                        CONTROL SET TEXT CBHNDL, 125, txt1
                                        invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                                        updatewindow hb4
                                    CASE 130 ' exit
                                        DIALOG END CBHNDL, 0
                                    CASE ELSE
                                END SELECT
                            CASE ELSE
                        END SELECT
                    CASE ELSE
                END SELECT
                EXIT FUNCTION
                '
                initnet:
                    n = 0  ' initialize counter
                    RANDOMIZE TIMER ' seed the random number generator
                    FOR j = 1 TO inputs ' initialize weights with value from -1.25 to 1.25
                        FOR k = 1 TO hiddens
                            weightj(k, j) = RND * 2.5! - 1.25! ' layer j
                        NEXT
                    NEXT
                    FOR j = 1 TO hiddens ' also for weights in the k layer
                        FOR k = 1 TO outputs
                            weightk(k, j) = RND * 2.5! - 1.25! ' and layer k
                        NEXT
                    NEXT
                    '
                    i = 0
                    FOR j = 1 TO outputs
                        FOR k = 1 TO inputs - 1
                            INCR i
                            bitmp(j, k) = VAL(READ$(i))
                        NEXT
                        INCR i : targetchar(j) = READ$(i)
                        FOR k = 1 TO outputs
                            targetneur(j, k) = 0!
                        NEXT
                        bitm = (ASC(targetchar(j)) - 47)
                        targetneur(j, bitm) = 1!
                        bitmp(j, inputs) = 1 ' this is the bias value - always one
                    NEXT
                    '
                    n = 1
                    GOSUB trainnet
                    lpsz = " pass "+FORMAT$(n,"#")+"      "
                    textout memdc, dialwidth *0.86 ,dialheight*0.04, lpsz, BYVAL LEN(lpsz)
                    pause = 1
                    invalidaterect CBHNDL,BYVAL %null,BYVAL %false
                    CONTROL ENABLE CBHNDL, 110
                    CONTROL ENABLE CBHNDL, 120
                    CONTROL SET TEXT CBHNDL, 125, "&pause"
                    CONTROL DISABLE CBHNDL, 125
                    '
                    ' 4 x 5 bitmaps of the numerals 0 to 9
                    DATA    0, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    1, 0, 0, 1
                    DATA    1, 0, 0, 1
                    DATA    0, 1, 1, 0
                    ' "target" for this bitmap
                    DATA    "0"
                    '
                    DATA    0, 1, 0, 0
                    DATA    1, 1, 0, 0
                    DATA    0, 1, 0, 0
                    DATA    0, 1, 0, 0
                    DATA    1, 1, 1, 0
                    DATA    "1"
                    '
                    DATA    0, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    0, 0, 1, 0
                    DATA    0, 1, 0, 0
                    DATA    1, 1, 1, 1
                    DATA    "2"
                    '
                    DATA    1, 1, 1, 0
                    DATA    0, 0, 0, 1
                    DATA    0, 1, 1, 0
                    DATA    0, 0, 0, 1
                    DATA    1, 1, 1, 0
                    DATA    "3"
                    '
                    DATA    1, 0, 0, 0
                    DATA    1, 0, 1, 0
                    DATA    1, 1, 1, 1
                    DATA    0, 0, 1, 0
                    DATA    0, 0, 1, 0
                    DATA    "4"
                    '
                    DATA    1, 1, 1, 1
                    DATA    1, 0, 0, 0
                    DATA    1, 1, 1, 0
                    DATA    0, 0, 0, 1
                    DATA    1, 1, 1, 0
                    DATA    "5"
                    '
                    DATA    0, 1, 1, 1
                    DATA    1, 0, 0, 0
                    DATA    1, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    0, 1, 1, 0
                    DATA    "6"
                    '
                    DATA    1, 1, 1, 1
                    DATA    0, 0, 0, 1
                    DATA    0, 0, 1, 0
                    DATA    0, 1, 0, 0
                    DATA    0, 1, 0, 0
                    DATA    "7"
                    '
                    DATA    0, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    0, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    0, 1, 1, 0
                    DATA    "8"
                    '
                    DATA    0, 1, 1, 0
                    DATA    1, 0, 0, 1
                    DATA    0, 1, 1, 1
                    DATA    0, 0, 0, 1
                    DATA    1, 1, 1, 0
                    DATA    "9"
                    '
                RETURN
                '
                '
                trainnet:
                ' the trainning loop starts here
                    m = (n - 1) MOD outputs + 1 ' pattern being presented - varies from 1 to outputs
                    lpsz = " pattern "+FORMAT$(m,"#")+"     "
                    textout memdc, dialwidth *0.86 ,dialheight*0.09, lpsz, BYVAL LEN(lpsz)
                    ' draw current input pattern
                    stx = dialwidth * 0.861 : sty = dialheight*0.15
                    selectobject memdc, getstockobject(%black_pen)
                    FOR i1 = 1 TO 20 STEP 4
                        FOR i2 = 0 TO 3
                            selectobject memdc, brush(1 + FIX(bitmp(m, i1 + i2) * 16 + 0.5))
                            rectangle memdc, stx + i2 * 16, sty + i1 * 4, stx + (i2+1) * 16, sty + (i1+4) * 4
                        NEXT
                    NEXT
                    ' forward pass calculates the nets and outs for each neuron
                    FOR k=1 TO inputs : btt(k) = bitmp(m,k) : NEXT ' transfer to current bitmap array
                    MAT netj() = weightj() * btt() ' calculate netj-array using mat statement
                    '
                    FOR k = 1 TO hiddens
                        FOR l = 1 TO inputs ' 20 input bits and a bias value
                            ' draw connections from input neurons to hidden neurons
                            te = btt(l) * weightj(k, l)
                            selectobject memdc, pen(FIX(1.5 + 16 * (1! / (1! + EXP(-te)))))
                            movetoex memdc, xi(l), yi(l), BYVAL %null
                            lineto memdc, xh(k), yh(k)
                        NEXT
                        ' calculate resultant output from hidden neuron k
                        outj(k) = 1! / (1! + EXP(-netj(k))) ' non - linearity
                    NEXT
                    outj(hiddens) = 1! ' force the bias neuron to one
                    '
                    ' draw input neurons
                    FOR l = 1 TO inputs
                        lpsz = FORMAT$(bitmp(m, l),"#")+"    "
                        textout memdc, xi(l)-5 ,dialheight*0.04, lpsz, BYVAL LEN(lpsz)
                        tem = FIX(1.5 + 16 * bitmp(m, l))
                        selectobject memdc, pen(tem)
                        selectobject memdc, brush(tem)
                        ELLIPSE memdc, xi(l) - rad, yi(l) - rad, xi(l) + rad, yi(l) + rad
                    NEXT
                    '
                    ' calculate nets and out for layer k (output layer)
                    ' calculate netk-array using mat statement
                    MAT netk() = weightk() * outj()
            
                    FOR k = 1 TO outputs
                        FOR l = 1 TO hiddens
                            ' draw connections
                            te = outj(l) * weightk(k, l)
                            selectobject memdc, pen(FIX(1.5 + 16 * (1! / (1! + EXP(-te)))))
                            movetoex memdc, xh(l), yh(l), BYVAL %null
                            lineto memdc, xo(k), yo(k)
                        NEXT
                        outk(k) = 1! / (1! + EXP(-netk(k))) ' transfer function
                        ' find the deltas for the output layer
                        deltak(k) = (outk(k) + enhance) * (1! - outk(k) + enhance) * (targetneur(m, k) - outk(k))
                    NEXT
                    ' draw hidden neurons
                    FOR l = 1 TO hiddens
                        tem = FIX(1.5 + 16 * outj(l))
                        selectobject memdc, pen(tem)
                        selectobject memdc, brush(tem)
                        ELLIPSE memdc, xh(l) - rad, yh(l) - rad, xh(l) + rad, yh(l) + rad
                    NEXT
                    ' draw output neurons
                    FOR k = 1 TO outputs
                        lpsz = FORMAT$(outk(k),"#.00")
                        textout memdc, xo(k)-15, dialheight*0.93, lpsz, BYVAL LEN(lpsz)
                        tem = FIX(1.5 + 16 * outk(k))
                        selectobject memdc, pen(tem)
                        selectobject memdc, brush(tem)
                        ELLIPSE memdc, xo(k) - rad, yo(k) - rad, xo(k) + rad, yo(k) + rad
                    NEXT
                    ' draw correct output being trained for
                    FOR k = 1 TO outputs
                        lpsz = FORMAT$(targetneur(m, k),"#")
                        textout memdc, xo(k)-4, dialheight*1.04, lpsz, BYVAL LEN(lpsz)
                        tem = FIX(1.5 + 16 * targetneur(m, k))
                        selectobject memdc, pen(tem)
                        selectobject memdc, brush(tem)
                        ELLIPSE memdc, xo(k) - rad, yo(k) - rad + dialheight*0.11, xo(k) + rad, yo(k) + rad + dialheight*0.11
                    NEXT
                    '
                    IF ISTRUE paintflag THEN RETURN ' if extra paint is needed just do that without adjusting the weights.
                    ' reverse pass.. to adjust the weights
                    FOR j = 1 TO hiddens
                        sumdelta = 0! ' clear from previous pass
                        FOR k = 1 TO outputs
                            ' prepare for the hidden layer, first
                            sumdelta = sumdelta + deltak(k) * weightk(k, j)
                            ' then adjust the weights for the k layer
                            weightk(k, j) = weightk(k, j) + deltak(k) * outj(j)
                        NEXT
                        ' now get the deltas for the hidden layer.
                        deltaj(j) = (outj(j) + enhance) * (1! - outj(j) + enhance) * sumdelta
                    NEXT
                    ' adjust the weights for the hidden layer.
                    FOR k = 1 TO hiddens
                        FOR j = 1 TO inputs
                            weightj(k, j) = weightj(k, j) + deltaj(k) * bitmp(m, j)
                        NEXT
                    NEXT
                    '
                RETURN
                '
            END FUNCTION
            '
            FUNCTION PBMAIN
                LOCAL hform1&,rc AS rect,i&,count&
                LOCAL x1&, y1&
                systemparametersinfo %spi_getworkarea,BYVAL 0, BYVAL VARPTR(rc),BYVAL 0
                DIALOG NEW PIXELS, 0, "neural network demonstration",,,0,0,%WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION _
                    OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN, 0 TO hform1&
                movewindow hform1&, rc.nleft, rc.ntop, rc.nright-rc.nleft, rc.nbottom-rc.ntop, %true
                getclientrect hform1&,rc
                dialheight = rc.nbottom : dialwidth = rc.nright
                x1 = dialwidth :  y1 = dialheight
                DIALOG SET COLOR hform1&, RGB(255,255,255),  RGB(0,0,0)
                dialheight = dialheight*0.91
                y1 = dialheight
                CONTROL ADD BUTTON, hform1&,  100,  "&initialize", x1*.83, y1*0.80, x1*.15, Y1*0.037, _
                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
                CONTROL ADD BUTTON, hform1&,  110,  "train &slowly", x1*.83, y1*0.84, x1*.15, Y1*0.037, _
                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP OR %WS_DISABLED
                CONTROL ADD BUTTON, hform1&,  120,  "train &fast", x1*.83, y1*0.88, x1*.15, Y1*0.037, _
                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP OR %WS_DISABLED
                CONTROL ADD BUTTON, hform1&,  125,  "&pause", x1*.83, y1*0.92, x1*.15, Y1*0.037, _
                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP OR %WS_DISABLED
                CONTROL ADD BUTTON, hform1&,  130,  "e&xit", x1*.83, y1*0.96, x1*.15, Y1*0.037, _
                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
                DIALOG SHOW MODAL hform1&, CALL dialcallback
                FOR i&=1 TO 17 : deleteobject pen(i) : deleteobject brush(i) : NEXT
                deletedc memdc : deleteobject hbit
            END FUNCTION
            Attached Files
            Last edited by Erik Christensen; 29 Aug 2013, 09:57 AM. Reason: small change to improve display

            Comment


            • #7
              Deep Learning

              Any thoughts of moving this towards convolutional neural network for deep learning?

              I may try to tackle it...lots of reading and studying to do first...but hoping this code can be starting point...but not really sure.

              Comment


              • #8
                Somehow I've missed this one, very cool, thanks.

                I made a small change that would allow it to train for outputting binary or ascii values @ line 240.

                Code:
                'bitm = (ASC(targetchar(j)) - 47)
                'targetneur(j, bitm) = 1!
                'bitm = ASC(targetchar(j))-47: ' Train output ascii value
                bitm = Asc(targetchar(j)): ' Train output binary value
                pat = Right$("000000000" + Bin$( bitm ), 9 )
                For k=1 To 9
                  targetneur(j, k) = Val(Mid$(pat,k,1))
                Next
                LarryC
                Website
                Sometimes life's a dream, sometimes it's a scream

                Comment


                • #9
                  Kevin,

                  You may find some additional ideas in this thread:

                  http://www.powerbasic.com/support/pb...ad.php?t=30780

                  The essential code can easily be expanded to increase the number of hidden neurons, include a learning rate, a momentum term and an additional hidden layer. This should be sufficient to make the network learn even very complex data structures. Be aware though of the risk of overfitting, which will increase with the number of hidden neurons and layers! The performance of the trained network should always be tested on independent data not used for training the network.

                  Best regards,

                  Erik

                  Comment


                  • #10
                    Deep Learning

                    Thanks Eric for the reply. I had read through those posts already. i am somewhat familiar with neural nets having previously coded recurrent neural nets that were evolved with genetic algorithms. It was a nice side project that I did in PB and actually worked on what is a challenging problem to solve: namely evolving not only weights but network structure for a fully recurrent network via a GA.

                    I don't have much spare times these days but have been doing some casual reading on recent AI developments and the new convolutional neural nets with deep learning are starting to perform some rather remarkable feats. This has caught my attention so I going to take some time for a deep dive back into it.

                    I already know how to make your network deeper with more hidden layers. That would be easy thanks to the nice foundation you laid...although I would bypass the graphical representation

                    But there is much more to CNN's and deep learning than that. it is a different paradigm than the typical ANN requiring a different structure, learning method, functions, etc. There is also the annoying upfront process of data preparation since in this case you work with much more complex input data sets with subsampling.


                    Best,
                    Kevin

                    Comment


                    • #11
                      Kevin

                      I agree that CNN (Convolutional Neural Networks), which are inspired by specific biologic neural systems (e.g. the visual cortex), are much more complex than the relatively simple ANN (Artificial Neural Networks). I wonder what you would use the CNN for? Perhaps for rcognition of specific features in complex pictures? That would certainly be an exiting field to explore. It would certainly be interesting to know of any code you might develop in this field. Good luck with your endeavour.

                      Best regards,

                      Erik

                      Comment

                      Working...
                      X