├── .xvpics ├── lena.jpg ├── lena4.jpg ├── peppers-scaled.pgm └── peppers.pgm ├── Makefile ├── README.md ├── imgcompr.tcl ├── imgmemo.tcl ├── imgscaling.tcl ├── lena.jpg ├── lena.pgm ├── lena4.jpg ├── mandrill.pgm ├── nn.c ├── nn.h ├── papers ├── JIS_99.ps └── Masalmah_Yahya2.pdf ├── peppers-scaled.pgm ├── peppers.pgm ├── tclgnegnu.c └── test.tcl /.xvpics/lena.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/.xvpics/lena.jpg -------------------------------------------------------------------------------- /.xvpics/lena4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/.xvpics/lena4.jpg -------------------------------------------------------------------------------- /.xvpics/peppers-scaled.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/.xvpics/peppers-scaled.pgm -------------------------------------------------------------------------------- /.xvpics/peppers.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/.xvpics/peppers.pgm -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile 2 | # Copyright (C) 2003 by Salvatore Sanfilippo 3 | # all rights reserved 4 | 5 | # see the LICENSE file for COPYRIGHT and PERMISSION notice. 6 | 7 | .SUFFIXES: 8 | .SUFFIXES: .c .o 9 | 10 | CC=gcc 11 | LD=ld 12 | CFLAGS= -fPIC -Wall -O2 -g 13 | SHAREDFLAGS= -nostartfiles -shared -Wl,-soname,libtclgnegnu.so.0 14 | INCLUDES= -I/usr/include/tcl8.4 15 | DEFS= 16 | 17 | RANLIB=/usr/bin/ranlib 18 | AR=/usr/bin/ar 19 | SHELL= /bin/sh 20 | 21 | INSTALL= /usr/bin/install 22 | INSTALL_PROGRAM= $(INSTALL) -m 755 23 | INSTALL_DATA= $(INSTALL) -m 644 24 | 25 | LIBPATH=/usr/local/lib 26 | BINPATH=/usr/local/bin 27 | COMPILE_TIME= 28 | 29 | all: .depend tclgnegnu.so 30 | 31 | .depend: 32 | @$(CC) $(INCLUDES) -MM *.c > .depend 33 | @echo Making dependences 34 | 35 | .c.o: 36 | $(CC) $(INCLUDES) $(CFLAGS) $(DEFS) -c $< -o $@ 37 | 38 | tclgnegnu.so: tclgnegnu.o nn.o 39 | rm -f tclgnegnu.so 40 | $(LD) -o tclgnegnu.so -bundle -undefined dynamic_lookup tclgnegnu.o nn.o -ldl -lm -lc 41 | 42 | clean: 43 | rm -f *.o tclgnegnu.so .depend 44 | 45 | ifeq (.depend,$(wildcard .depend)) 46 | include .depend 47 | endif 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Today (13 Sep 2016) I happened to find my 2003-2004 experiments with neural 2 | networks and specifically image compression. The GPU times were very far 3 | and the interest in neural networks was relatively low at the time, however 4 | I really loved the concept and used some free time to play with them. 5 | 6 | With my surprise, the code still compiles and run! Compressing a few test 7 | images using 8x8 blocks as inputs, an interediate layer of 8 neurons, and 8 | an 8x8 output. 9 | 10 | The neural network implementation uses back propagation and has a few 11 | configurable parameters. I guess it's a bit different compared to the new 12 | NN implementations. For instance the sigmoid function is used, and only 13 | CPU training is supported, of course. 14 | 15 | I can't really recall the details, but I'm pushing this now completely 16 | useless code just for archiving goals. 17 | -------------------------------------------------------------------------------- /imgcompr.tcl: -------------------------------------------------------------------------------- 1 | package require Tk 2 | load tclgnegnu.so 3 | 4 | proc scan2net l { 5 | set l [eval concat $l] 6 | foreach p $l { 7 | lappend nl [expr {double([scan $p #%02x])/255}] 8 | } 9 | return $nl 10 | } 11 | 12 | proc net2scan {l bxlen bylen} { 13 | set c 0 14 | for {set i 0} {$i < $bylen} {incr i} { 15 | set scanline {} 16 | for {set j 0} {$j < $bxlen} {incr j} { 17 | set p [lindex $l $c] 18 | incr c 19 | set p [expr {int($p*255)}] 20 | lappend scanline [format "#%02x%02x%02x" $p $p $p] 21 | } 22 | lappend result $scanline 23 | } 24 | return $result 25 | } 26 | 27 | proc blocks {ximglen yimglen bxlen bylen} { 28 | for {set y 0} {$y < $yimglen} {incr y $bylen} { 29 | for {set x 0} {$x < $ximglen} {incr x $bxlen} { 30 | lappend result [list $x $y [expr {$x+$bxlen}] [expr {$y+$bylen}]] 31 | } 32 | } 33 | return $result 34 | } 35 | 36 | set blockxlen 8 37 | set blockylen 8 38 | set blockpixels [expr {$blockylen*$blockxlen}] 39 | pack [canvas .c -height 1024 -width 1024] 40 | 41 | set image1 lena 42 | set image2 mandrill 43 | 44 | set i [image create photo -file $image1.pgm] 45 | set i2 [image create photo -file $image2.pgm] 46 | set io [image create photo -file $image1.pgm] 47 | set i2o [image create photo -file $image2.pgm] 48 | set imgid [.c create image 256 256 -image $i] 49 | set imgid2 [.c create image 256 768 -image $i2] 50 | set imgid3 [.c create image 768 256 -image $io] 51 | set imgid4 [.c create image 768 768 -image $i2o] 52 | update idletasks 53 | 54 | set blocks [blocks 512 512 $blockxlen $blockylen] 55 | set net [ann::create $blockpixels 8 $blockpixels] 56 | ann::configure net -algo rprop -scale .01 57 | 58 | # Create the dataset 59 | foreach b $blocks { 60 | foreach {x1 y1 x2 y2} $b break 61 | set bi [scan2net [$i data -grayscale -from $x1 $y1 $x2 $y2]] 62 | lappend dataset $bi $bi 63 | } 64 | 65 | # Create the second dataset 66 | foreach b $blocks { 67 | foreach {x1 y1 x2 y2} $b break 68 | set bi [scan2net [$i2 data -grayscale -from $x1 $y1 $x2 $y2]] 69 | lappend dataset2 $bi $bi 70 | } 71 | 72 | # Train the network 73 | while {1} { 74 | puts . 75 | ann::train net $dataset 100 76 | #ann::train net $dataset2 25 77 | set c 0 78 | foreach b $blocks { 79 | foreach {x1 y1 x2 y2} $b break 80 | set netinput [lindex $dataset $c] 81 | incr c 2 82 | set netoutput [ann::simulate net $netinput] 83 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 84 | $i put $scanlines -to $x1 $y1 $x2 $y2 85 | } 86 | set c 0 87 | foreach b $blocks { 88 | foreach {x1 y1 x2 y2} $b break 89 | set netinput [lindex $dataset2 $c] 90 | incr c 2 91 | set netoutput [ann::simulate net $netinput] 92 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 93 | $i2 put $scanlines -to $x1 $y1 $x2 $y2 94 | } 95 | update 96 | } 97 | 98 | #set l [$i data -grayscale -from 0 0 8 8] 99 | #set ni [scan2net $l] 100 | #puts $ni 101 | #puts [net2scan $ni] 102 | exit 103 | -------------------------------------------------------------------------------- /imgmemo.tcl: -------------------------------------------------------------------------------- 1 | package require Tk 2 | load tclgnegnu.so 3 | 4 | proc scan2net l { 5 | set l [eval concat $l] 6 | foreach p $l { 7 | lappend nl [expr {double([scan $p #%02x])/255}] 8 | } 9 | return $nl 10 | } 11 | 12 | proc net2scan {l bxlen bylen} { 13 | set c 0 14 | for {set i 0} {$i < $bylen} {incr i} { 15 | set scanline {} 16 | for {set j 0} {$j < $bxlen} {incr j} { 17 | set p [lindex $l $c] 18 | incr c 19 | set p [expr {int($p*255)}] 20 | lappend scanline [format "#%02x%02x%02x" $p $p $p] 21 | } 22 | lappend result $scanline 23 | } 24 | return $result 25 | } 26 | 27 | proc blocks {ximglen yimglen bxlen bylen} { 28 | for {set y 0} {$y < $yimglen} {incr y $bylen} { 29 | for {set x 0} {$x < $ximglen} {incr x $bxlen} { 30 | lappend result [list $x $y [expr {$x+$bxlen}] [expr {$y+$bylen}]] 31 | } 32 | } 33 | return $result 34 | } 35 | 36 | set blockxlen 8 37 | set blockylen 8 38 | set blockpixels [expr {$blockylen*$blockxlen}] 39 | pack [canvas .c -height 1024 -width 1024] 40 | 41 | set image1 lena 42 | set image2 mandrill 43 | 44 | set i [image create photo -file $image1.pgm] 45 | set i2 [image create photo -file $image2.pgm] 46 | set io [image create photo -file $image1.pgm] 47 | set i2o [image create photo -file $image2.pgm] 48 | set imgid [.c create image 256 256 -image $i] 49 | set imgid2 [.c create image 256 768 -image $i2] 50 | set imgid3 [.c create image 768 256 -image $io] 51 | set imgid4 [.c create image 768 768 -image $i2o] 52 | update idletasks 53 | 54 | set blocks [blocks 512 512 $blockxlen $blockylen] 55 | set net [ann::create $blockpixels 16 $blockpixels] 56 | 57 | # Create the dataset 58 | foreach b $blocks { 59 | foreach {x1 y1 x2 y2} $b break 60 | set bi [scan2net [$i data -grayscale -from $x1 $y1 $x2 $y2]] 61 | lappend dataset $bi $bi 62 | } 63 | 64 | # Create the second dataset 65 | foreach b $blocks { 66 | foreach {x1 y1 x2 y2} $b break 67 | set bi [scan2net [$i2 data -grayscale -from $x1 $y1 $x2 $y2]] 68 | lappend dataset2 $bi $bi 69 | } 70 | 71 | # Train the network 72 | while {1} { 73 | puts . 74 | ann::train net $dataset 25 75 | #ann::train net $dataset2 25 76 | set c 0 77 | foreach b $blocks { 78 | foreach {x1 y1 x2 y2} $b break 79 | set netinput [lindex $dataset $c] 80 | incr c 2 81 | set netoutput [ann::simulate net $netinput] 82 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 83 | $i put $scanlines -to $x1 $y1 $x2 $y2 84 | } 85 | set c 0 86 | foreach b $blocks { 87 | foreach {x1 y1 x2 y2} $b break 88 | set netinput [lindex $dataset2 $c] 89 | incr c 2 90 | set netoutput [ann::simulate net $netinput] 91 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 92 | $i2 put $scanlines -to $x1 $y1 $x2 $y2 93 | } 94 | update idletasks 95 | } 96 | 97 | #set l [$i data -grayscale -from 0 0 8 8] 98 | #set ni [scan2net $l] 99 | #puts $ni 100 | #puts [net2scan $ni] 101 | exit 102 | -------------------------------------------------------------------------------- /imgscaling.tcl: -------------------------------------------------------------------------------- 1 | package require Tk 2 | load tclgnegnu.so 3 | 4 | proc reduce l { 5 | set ylen [llength $l] 6 | for {set y 0} {$y < $ylen} {incr y 2} { 7 | set scanline {} 8 | foreach {p _} [lindex $l $y] { 9 | lappend scanline $p 10 | } 11 | lappend result $scanline 12 | } 13 | return $result 14 | } 15 | 16 | proc reduced2net l { 17 | scan2net [reduce $l] 18 | } 19 | 20 | proc scan2net l { 21 | set l [eval concat $l] 22 | foreach p $l { 23 | lappend nl [expr {double([scan $p #%02x])/255}] 24 | } 25 | return $nl 26 | } 27 | 28 | proc net2scan {l bxlen bylen} { 29 | set c 0 30 | for {set i 0} {$i < $bylen} {incr i} { 31 | set scanline {} 32 | for {set j 0} {$j < $bxlen} {incr j} { 33 | set p [lindex $l $c] 34 | incr c 35 | set p [expr {int($p*255)}] 36 | lappend scanline [format "#%02x%02x%02x" $p $p $p] 37 | } 38 | lappend result $scanline 39 | } 40 | return $result 41 | } 42 | 43 | proc blocks {ximglen yimglen bxlen bylen} { 44 | for {set y 0} {$y < $yimglen} {incr y $bylen} { 45 | for {set x 0} {$x < $ximglen} {incr x $bxlen} { 46 | lappend result [list $x $y [expr {$x+$bxlen}] [expr {$y+$bylen}]] 47 | } 48 | } 49 | return $result 50 | } 51 | 52 | set blockxlen 8 53 | set blockylen 8 54 | set blockpixels [expr {$blockylen*$blockxlen}] 55 | pack [canvas .c -height 1024 -width 1024] 56 | 57 | set i [image create photo -file lena.pgm] 58 | set i2 [image create photo -file peppers.pgm] 59 | set io [image create photo -file lena.pgm] 60 | set i2o [image create photo -file peppers-scaled.pgm] 61 | set imgid [.c create image 256 256 -image $i] 62 | set imgid2 [.c create image 256 768 -image $i2] 63 | set imgid3 [.c create image 768 256 -image $io] 64 | set imgid4 [.c create image 768 768 -image $i2o] 65 | update idletasks 66 | 67 | set blocks [blocks 512 512 $blockxlen $blockylen] 68 | set blocks2 [blocks 256 256 4 4] 69 | set net [ann::create $blockpixels 16 16] 70 | 71 | # Create the dataset 72 | foreach b $blocks { 73 | foreach {x1 y1 x2 y2} $b break 74 | set bi [reduced2net [$i data -grayscale -from $x1 $y1 $x2 $y2]] 75 | set bo [scan2net [$i data -grayscale -from $x1 $y1 $x2 $y2]] 76 | lappend dataset $bi $bo 77 | } 78 | 79 | # Create the second dataset 80 | foreach b $blocks2 { 81 | foreach {x1 y1 x2 y2} $b break 82 | set bi [scan2net [$i2o data -grayscale -from $x1 $y1 $x2 $y2]] 83 | lappend dataset2 $bi $bo 84 | } 85 | 86 | # Train the network 87 | while {1} { 88 | puts . 89 | ann::train net $dataset 25 90 | set c 0 91 | foreach b $blocks { 92 | foreach {x1 y1 x2 y2} $b break 93 | set netinput [lindex $dataset $c] 94 | incr c 2 95 | set netoutput [ann::simulate net $netinput] 96 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 97 | $i put $scanlines -to $x1 $y1 $x2 $y2 98 | } 99 | set c 0 100 | foreach b $blocks2 bo $blocks { 101 | foreach {x1 y1 x2 y2} $b break 102 | foreach {ox1 oy1 ox2 oy2} $bo break 103 | set netinput [lindex $dataset2 $c] 104 | incr c 2 105 | set netoutput [ann::simulate net $netinput] 106 | set scanlines [net2scan $netoutput $blockxlen $blockylen] 107 | $i2 put $scanlines -to $ox1 $oy1 $ox2 $oy2 108 | } 109 | update idletasks 110 | } 111 | 112 | #set l [$i data -grayscale -from 0 0 8 8] 113 | #set ni [scan2net $l] 114 | #puts $ni 115 | #puts [net2scan $ni] 116 | exit 117 | -------------------------------------------------------------------------------- /lena.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/lena.jpg -------------------------------------------------------------------------------- /lena.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/lena.pgm -------------------------------------------------------------------------------- /lena4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/lena4.jpg -------------------------------------------------------------------------------- /mandrill.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/mandrill.pgm -------------------------------------------------------------------------------- /nn.c: -------------------------------------------------------------------------------- 1 | /* gnegnu NN - Artificial Neural Networks implementation 2 | * Copyright(C) 2003 Salvatore Sanfilippo 3 | * All rights reserved. */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "nn.h" 12 | 13 | /* TODO: 14 | * Load/Save nets on file 15 | * Read training data from file 16 | * Ability to print the net as a C function with hard-coded weights. 17 | */ 18 | 19 | /* Node Trasnfer Function */ 20 | double sigmoid(double x) { 21 | return (double)1/(1+exp(-x)); 22 | } 23 | 24 | /* Reset layer data to zero-units */ 25 | void AnnResetLayer(struct AnnLayer *layer) 26 | { 27 | layer->units = 0; 28 | layer->output = NULL; 29 | layer->error = NULL; 30 | layer->weight = NULL; 31 | layer->gradient = NULL; 32 | layer->pgradient = NULL; 33 | layer->delta = NULL; 34 | layer->sgradient = NULL; 35 | } 36 | 37 | /* Allocate and return an initialized N-layers network */ 38 | struct Ann *AnnAlloc(int layers) 39 | { 40 | struct Ann *net; 41 | int i; 42 | 43 | /* Alloc the net structure */ 44 | if ((net = malloc(sizeof(*net))) == NULL) 45 | return NULL; 46 | /* Alloc layers */ 47 | if ((net->layer = malloc(sizeof(struct AnnLayer)*layers)) == NULL) { 48 | free(net); 49 | return NULL; 50 | } 51 | net->layers = layers; 52 | net->flags = 0; 53 | net->learn_rate = DEFAULT_LEARN_RATE; 54 | net->momentum = DEFAULT_MOMENTUM; 55 | net->rprop_nminus = DEFAULT_RPROP_NMINUS; 56 | net->rprop_nplus = DEFAULT_RPROP_NPLUS; 57 | net->rprop_maxupdate = DEFAULT_RPROP_MAXUPDATE; 58 | net->rprop_minupdate = DEFAULT_RPROP_MINUPDATE; 59 | /* Init layers */ 60 | for (i = 0; i < layers; i++) 61 | AnnResetLayer(&net->layer[i]); 62 | return net; 63 | } 64 | 65 | /* Free a single layer */ 66 | void AnnFreeLayer(struct AnnLayer *layer) 67 | { 68 | free(layer->output); 69 | free(layer->error); 70 | free(layer->weight); 71 | free(layer->gradient); 72 | free(layer->pgradient); 73 | free(layer->delta); 74 | free(layer->sgradient); 75 | AnnResetLayer(layer); 76 | } 77 | 78 | /* Free the target net */ 79 | void AnnFree(struct Ann *net) 80 | { 81 | int i; 82 | 83 | /* Free layer data */ 84 | for (i = 0; i < net->layers; i++) { 85 | AnnFreeLayer(&net->layer[i]); 86 | } 87 | /* Free allocated layers structures */ 88 | free(net->layer); 89 | /* And the main structure itself */ 90 | free(net); 91 | } 92 | 93 | /* Init a layer of the net with the specified number of units. 94 | * Return non-zero on out of memory. */ 95 | int AnnInitLayer(struct Ann *net, int i, int units, int bias) 96 | { 97 | if (bias) 98 | units++; /* Take count of the bias unit */ 99 | net->layer[i].output = malloc(sizeof(double)*units); 100 | net->layer[i].error = malloc(sizeof(double)*units); 101 | if (i) { /* not for output layer */ 102 | net->layer[i].weight = malloc(sizeof(double)*units*net->layer[i-1].units); 103 | net->layer[i].gradient = malloc(sizeof(double)*units*net->layer[i-1].units); 104 | net->layer[i].pgradient = malloc(sizeof(double)*units*net->layer[i-1].units); 105 | net->layer[i].delta = malloc(sizeof(double)*units*net->layer[i-1].units); 106 | net->layer[i].sgradient = malloc(sizeof(double)*units*net->layer[i-1].units); 107 | } 108 | net->layer[i].units = units; 109 | /* Check for out of memory conditions */ 110 | if (net->layer[i].output == NULL || 111 | net->layer[i].error == NULL || 112 | (i && net->layer[i].weight == NULL) || 113 | (i && net->layer[i].gradient == NULL) || 114 | (i && net->layer[i].pgradient == NULL) || 115 | (i && net->layer[i].sgradient == NULL) || 116 | (i && net->layer[i].delta == NULL)) 117 | { 118 | AnnFreeLayer(&net->layer[i]); 119 | AnnResetLayer(&net->layer[i]); 120 | return 1; 121 | } 122 | /* set all the values to zero */ 123 | memset(net->layer[i].output, 0, sizeof(double)*units); 124 | memset(net->layer[i].error, 0, sizeof(double)*units); 125 | if (i) { 126 | memset(net->layer[i].weight, 0, sizeof(double)*units*net->layer[i-1].units); 127 | memset(net->layer[i].gradient, 0, sizeof(double)*units*net->layer[i-1].units); 128 | memset(net->layer[i].pgradient, 0, sizeof(double)*units*net->layer[i-1].units); 129 | memset(net->layer[i].delta, 0, sizeof(double)*units*net->layer[i-1].units); 130 | memset(net->layer[i].sgradient, 0, sizeof(double)*units*net->layer[i-1].units); 131 | } 132 | /* Set the bias unit output ot 1 */ 133 | if (bias) 134 | net->layer[i].output[units-1] = 1; 135 | return 0; 136 | } 137 | 138 | /* Clone a network. On out of memory NULL is returned. */ 139 | struct Ann *AnnClone(struct Ann* net) 140 | { 141 | struct Ann* copy; 142 | int j; 143 | 144 | if ((copy = AnnAlloc(LAYERS(net))) == NULL) 145 | return NULL; 146 | for (j = 0; j < LAYERS(net); j++) { 147 | struct AnnLayer *ldst, *lsrc; 148 | int units = UNITS(net,j); 149 | int weights = WEIGHTS(net,j); 150 | if (AnnInitLayer(copy, j, UNITS(net,j), 0)) { 151 | AnnFree(copy); 152 | return NULL; 153 | } 154 | lsrc = &net->layer[j]; 155 | ldst = ©->layer[j]; 156 | if (lsrc->output) 157 | memcpy(ldst->output, lsrc->output, sizeof(double)*units); 158 | if (lsrc->error) 159 | memcpy(ldst->error, lsrc->error, sizeof(double)*units); 160 | if (lsrc->weight) 161 | memcpy(ldst->weight, lsrc->weight, sizeof(double)*weights); 162 | if (lsrc->gradient) 163 | memcpy(ldst->gradient, lsrc->gradient, sizeof(double)*weights); 164 | if (lsrc->pgradient) 165 | memcpy(ldst->pgradient, lsrc->pgradient, sizeof(double)*weights); 166 | if (lsrc->delta) 167 | memcpy(ldst->delta, lsrc->delta, sizeof(double)*weights); 168 | if (lsrc->sgradient) 169 | memcpy(ldst->sgradient, lsrc->sgradient, sizeof(double)*weights); 170 | } 171 | copy->learn_rate = net->learn_rate; 172 | copy->momentum = net->momentum; 173 | copy->rprop_nminus = net->rprop_nminus; 174 | copy->rprop_nplus = net->rprop_nplus; 175 | copy->rprop_maxupdate = net->rprop_maxupdate; 176 | copy->rprop_minupdate = net->rprop_minupdate; 177 | copy->flags = net->flags; 178 | return copy; 179 | } 180 | 181 | /* Set the learning algorithm, and initialized the net 182 | * to work with such algorithm. */ 183 | void AnnSetLearningAlgo(struct Ann *net, int algoid) 184 | { 185 | switch(algoid) { 186 | case ANN_BBPROP: 187 | case ANN_OBPROP: 188 | case ANN_BBPROPM: 189 | case ANN_OBPROPM: 190 | net->flags = (net->flags & (~ANN_ALGOMASK)) | algoid; 191 | AnnResetDeltas(net); 192 | break; 193 | case ANN_RPROP: 194 | net->flags = (net->flags & (~ANN_ALGOMASK)) | algoid; 195 | AnnSetDeltas(net, RPROP_INITIAL_DELTA); 196 | break; 197 | default: 198 | fprintf(stderr, "AnnSetLearningAlgo called with bad algoid\n"); 199 | exit(1); 200 | break; 201 | } 202 | } 203 | 204 | /* Create a N-layer input/hidden/output net. 205 | * The units array should specify the number of 206 | * units in every layer from the output to the input layer. */ 207 | struct Ann *AnnCreateNet(int layers, int *units) 208 | { 209 | struct Ann *net; 210 | int i; 211 | 212 | if ((net = AnnAlloc(layers)) == NULL) 213 | return NULL; 214 | for (i = 0; i < layers; i++) { 215 | if (AnnInitLayer(net, i, units[i], i > 1)) { 216 | AnnFree(net); 217 | return NULL; 218 | } 219 | } 220 | AnnSetRandomWeights(net); 221 | AnnSetLearningAlgo(net, ANN_RPROP); 222 | return net; 223 | } 224 | 225 | /* Create a 3-layer input/hidden/output net */ 226 | struct Ann *AnnCreateNet3(int iunits, int hunits, int ounits) 227 | { 228 | int units[3]; 229 | 230 | units[0] = ounits; 231 | units[1] = hunits; 232 | units[2] = iunits; 233 | return AnnCreateNet(3, units); 234 | } 235 | 236 | /* Create a 4-layer input/hidden/output net */ 237 | struct Ann *AnnCreateNet4(int iunits, int hunits, int hunits2, int ounits) 238 | { 239 | int units[4]; 240 | 241 | units[0] = ounits; 242 | units[1] = hunits2; 243 | units[2] = hunits; 244 | units[3] = iunits; 245 | return AnnCreateNet(4, units); 246 | } 247 | 248 | /* Simulate the net one time. */ 249 | void AnnSimulate(struct Ann *net) 250 | { 251 | int i, j, k; 252 | 253 | for (i = net->layers-1; i > 0; i--) { 254 | int nextunits = net->layer[i-1].units; 255 | int units = net->layer[i].units; 256 | if (i > 2) nextunits--; /* dont output on bias units */ 257 | for (j = 0; j < nextunits; j++) { 258 | double A = 0, W; 259 | for (k = 0; k < units; k++) { 260 | W = WEIGHT(net, i, k, j); 261 | A += W*OUTPUT(net, i, k); 262 | } 263 | OUTPUT(net, i-1, j) = sigmoid(A); 264 | } 265 | } 266 | } 267 | 268 | /* Create a Tcl procedure that simulates the neural network */ 269 | void Ann2Tcl(struct Ann *net) 270 | { 271 | int i, j, k; 272 | 273 | printf("proc ann input {\n"); 274 | printf(" set output {"); 275 | for (i = 0; i < OUTPUT_UNITS(net); i++) { 276 | printf("0 "); 277 | } 278 | printf("}\n"); 279 | for (i = net->layers-1; i > 0; i--) { 280 | int nextunits = net->layer[i-1].units; 281 | int units = net->layer[i].units; 282 | if (i > 2) nextunits--; /* dont output on bias units */ 283 | for (j = 0; j < nextunits; j++) { 284 | double W; 285 | if (i == 1) { 286 | printf(" lset output %d ", j); 287 | } else { 288 | printf(" set O_%d_%d", i-1, j); 289 | } 290 | printf(" [expr { \\\n"); 291 | for (k = 0; k < units; k++) { 292 | W = WEIGHT(net, i, k, j); 293 | if (i > 1 && k == units-1) { 294 | printf(" (%.9f)", W); 295 | } else if (i == net->layers-1) { 296 | printf(" (%.9f*[lindex $input %d])", W, k); 297 | } else { 298 | printf(" (%.9f*$O_%d_%d)", W, i, k); 299 | } 300 | if ((k+1) < units) printf("+ \\\n"); 301 | } 302 | printf("}]\n"); 303 | if (i == 1) { 304 | printf(" lset output %d [expr {1/(1+exp(-[lindex $output %d]))}]\n", j, j); 305 | } else { 306 | printf(" lset O_%d_%d [expr {1/(1+exp(-$O_%d_%d))}]\n", i-1, j, i-1, j); 307 | } 308 | } 309 | } 310 | printf(" return $output\n"); 311 | printf("}\n"); 312 | } 313 | 314 | /* Print a network representation */ 315 | void AnnPrint(struct Ann *net) 316 | { 317 | int i, j, k; 318 | 319 | for (i = 0; i < LAYERS(net); i++) { 320 | if (i) { 321 | /* Weights */ 322 | printf("\t\tW"); 323 | for (j = 0; j < UNITS(net, i); j++) { 324 | printf("("); 325 | for (k = 0; k < UNITS(net, i-1); k++) { 326 | printf("%f", WEIGHT(net,i,j,k)); 327 | if (k != UNITS(net, i-1)-1) 328 | printf(" "); 329 | } 330 | printf(") "); 331 | } 332 | printf("\n"); 333 | /* Gradients */ 334 | printf("\t\tg"); 335 | for (j = 0; j < UNITS(net, i); j++) { 336 | printf("["); 337 | for (k = 0; k < UNITS(net, i-1); k++) { 338 | printf("%f", GRADIENT(net,i,j,k)); 339 | if (k != UNITS(net, i-1)-1) 340 | printf(" "); 341 | } 342 | printf("] "); 343 | } 344 | printf("\n"); 345 | /* SGradients */ 346 | printf("\t\tG"); 347 | for (j = 0; j < UNITS(net, i); j++) { 348 | printf("["); 349 | for (k = 0; k < UNITS(net, i-1); k++) { 350 | printf("%f", SGRADIENT(net,i,j,k)); 351 | if (k != UNITS(net, i-1)-1) 352 | printf(" "); 353 | } 354 | printf("] "); 355 | } 356 | printf("\n"); 357 | /* Gradients at t-1 */ 358 | printf("\t\tM"); 359 | for (j = 0; j < UNITS(net, i); j++) { 360 | printf("["); 361 | for (k = 0; k < UNITS(net, i-1); k++) { 362 | printf("%f", PGRADIENT(net,i,j,k)); 363 | if (k != UNITS(net, i-1)-1) 364 | printf(" "); 365 | } 366 | printf("] "); 367 | } 368 | printf("\n"); 369 | /* Delta */ 370 | printf("\t\tD"); 371 | for (j = 0; j < UNITS(net, i); j++) { 372 | printf("|"); 373 | for (k = 0; k < UNITS(net, i-1); k++) { 374 | printf("%f", DELTA(net,i,j,k)); 375 | if (k != UNITS(net, i-1)-1) 376 | printf(" "); 377 | } 378 | printf("| "); 379 | } 380 | printf("\n"); 381 | } 382 | for (j = 0; j < UNITS(net,i); j++) { 383 | printf("%f ", OUTPUT(net,i,j)); 384 | } 385 | printf("\n"); 386 | printf("\t\t/"); 387 | for (j = 0; j < UNITS(net,i); j++) { 388 | printf("%f ", ERROR(net,i,j)); 389 | } 390 | printf("/\n"); 391 | } 392 | } 393 | 394 | /* Calcuate the global error of the net */ 395 | double AnnGlobalError(struct Ann *net, double *desidered) 396 | { 397 | double e, t; 398 | int i, outputs = OUTPUT_UNITS(net); 399 | 400 | e = 0; 401 | for (i = 0; i < outputs; i++) { 402 | t = desidered[i] - OUTPUT_NODE(net,i); 403 | e += fabs(t*t); 404 | } 405 | return .5*e; 406 | } 407 | 408 | /* Set the network input */ 409 | void AnnSetInput(struct Ann *net, double *input) 410 | { 411 | int i, inputs = INPUT_UNITS(net); 412 | 413 | for (i = 0; i < inputs; i++) 414 | INPUT_NODE(net,i) = input[i]; 415 | } 416 | 417 | /* Simulate the net, and return the global error */ 418 | double AnnSimulateError(struct Ann *net, double *input, double *desidered) 419 | { 420 | AnnSetInput(net, input); 421 | AnnSimulate(net); 422 | return AnnGlobalError(net, desidered); 423 | } 424 | 425 | /* Calculate gradients with a trivial and slow algorithm, this 426 | * is useful to check that the real implementation is working 427 | * well, comparing the results. 428 | * 429 | * The algorithm used is: to compute the error function in two 430 | * points (E1, with the real weight, and E2 with the weight W = W + 0.1), 431 | * than the approximation of the gradient is G = (E2-E1)/0.1. */ 432 | #define GTRIVIAL_DELTA 0.001 433 | void AnnCalculateGradientsTrivial(struct Ann *net, double *desidered) 434 | { 435 | int j, i, layers = LAYERS(net); 436 | 437 | for (j = 1; j < layers; j++) { 438 | int units = UNITS(net, j); 439 | int weights = units * UNITS(net,j-1); 440 | for (i = 0; i < weights; i++) { 441 | double t, e1, e2; 442 | 443 | /* Calculate the value of the error function 444 | * in this point. */ 445 | AnnSimulate(net); 446 | e1 = AnnGlobalError(net, desidered); 447 | t = net->layer[j].weight[i]; 448 | /* Calculate the error a bit on the right */ 449 | net->layer[j].weight[i] += GTRIVIAL_DELTA; 450 | AnnSimulate(net); 451 | e2 = AnnGlobalError(net, desidered); 452 | /* Restore the original weight */ 453 | net->layer[j].weight[i] = t; 454 | /* Calculate the gradient */ 455 | net->layer[j].gradient[i] = (e2-e1)/GTRIVIAL_DELTA; 456 | } 457 | } 458 | } 459 | 460 | /* Calculate gradients using the back propagation algorithm */ 461 | void AnnCalculateGradients(struct Ann *net, double *desidered) 462 | { 463 | int j, layers = LAYERS(net)-1; 464 | 465 | /* First we need to calculate the error for every output 466 | * node. */ 467 | for (j = 0; j < OUTPUT_UNITS(net); j++) { 468 | net->layer[0].error[j] = 469 | net->layer[0].output[j] - desidered[j]; 470 | } 471 | /* Back-propagate the error and compute the gradient 472 | * for every weight in the net. */ 473 | for (j = 0; j < layers; j++) { 474 | int units = UNITS(net, j); 475 | int i; 476 | 477 | /* Skip bias units */ 478 | if (j > 1) 479 | units--; 480 | /* Reset the next layer errors array */ 481 | for (i = 0; i < UNITS(net,j+1); i++) 482 | net->layer[j+1].error[i] = 0; 483 | /* For every node in this layer ... */ 484 | for (i = 0; i < units; i++) { 485 | double delta, e, o; 486 | int k, prevunits; 487 | 488 | /* Compute (d-o)*o*(1-o) */ 489 | e = net->layer[j].error[i]; 490 | o = net->layer[j].output[i]; 491 | delta = e*o*(1-o); 492 | /* For every weight between this node and 493 | * the previous layer's nodes... */ 494 | prevunits = UNITS(net,j+1); 495 | for (k = 0; k < prevunits; k++) { 496 | /* Calculate the gradient */ 497 | GRADIENT(net,j+1,k,i) = 498 | delta * OUTPUT(net,j+1,k); 499 | /* And back-propagate the error to 500 | * the previous layer */ 501 | ERROR(net,j+1,k) += 502 | delta * WEIGHT(net,j+1,k,i); 503 | } 504 | } 505 | } 506 | } 507 | 508 | /* Set the delta values of the net to a given value */ 509 | void AnnSetDeltas(struct Ann *net, double val) 510 | { 511 | int j, layers = LAYERS(net); 512 | 513 | for (j = 1; j < layers; j++) { 514 | int units = UNITS(net, j); 515 | int weights = units * UNITS(net,j-1); 516 | int i; 517 | 518 | for (i = 0; i < weights; i++) 519 | net->layer[j].delta[i] = val; 520 | } 521 | } 522 | 523 | /* Set deltas to zero */ 524 | void AnnResetDeltas(struct Ann *net) 525 | { 526 | return AnnSetDeltas(net, 0); 527 | } 528 | 529 | /* Set the sgradient values to zero */ 530 | void AnnResetSgradient(struct Ann *net) 531 | { 532 | int j, layers = LAYERS(net); 533 | 534 | for (j = 1; j < layers; j++) { 535 | int units = UNITS(net, j); 536 | int weights = units * UNITS(net,j-1); 537 | memset(net->layer[j].sgradient, 0, sizeof(double)*weights); 538 | } 539 | } 540 | 541 | /* Set random weights in the range -0.5,+0.5 */ 542 | void AnnSetRandomWeights(struct Ann *net) 543 | { 544 | int j, layers = LAYERS(net); 545 | 546 | srand(time(NULL)); 547 | for (j = 1; j < layers; j++) { 548 | int units = UNITS(net, j); 549 | int weights = units * UNITS(net,j-1); 550 | int i; 551 | 552 | for (i = 0; i < weights; i++) 553 | net->layer[j].weight[i] = -.5+(rand()/(RAND_MAX+1.0)); 554 | } 555 | } 556 | 557 | /* Scale the net weights of the given factor */ 558 | void AnnScaleWeights(struct Ann *net, double factor) 559 | { 560 | int j, layers = LAYERS(net); 561 | 562 | for (j = 1; j < layers; j++) { 563 | int units = UNITS(net, j); 564 | int weights = units * UNITS(net,j-1); 565 | int i; 566 | 567 | for (i = 0; i < weights; i++) 568 | net->layer[j].weight[i] *= factor; 569 | } 570 | } 571 | 572 | /* Update the deltas using the gradient descend algorithm. 573 | * Gradients should be already computed with AnnCalculateGraidents(). */ 574 | void AnnUpdateDeltasGD(struct Ann *net) 575 | { 576 | int j, i, layers = LAYERS(net); 577 | 578 | for (j = 1; j < layers; j++) { 579 | int units = UNITS(net, j); 580 | int weights = units * UNITS(net,j-1); 581 | for (i = 0; i < weights; i++) 582 | net->layer[j].delta[i] += -(LEARN_RATE(net)*net->layer[j].gradient[i]); 583 | } 584 | } 585 | 586 | /* Update the deltas using the gradient descend algorithm with momentum. 587 | * Gradients should be already computed with AnnCalculateGraidents(). */ 588 | void AnnUpdateDeltasGDM(struct Ann *net) 589 | { 590 | int j, i, layers = LAYERS(net); 591 | 592 | for (j = 1; j < layers; j++) { 593 | int units = UNITS(net, j); 594 | int weights = units * UNITS(net,j-1); 595 | for (i = 0; i < weights; i++) { 596 | net->layer[j].delta[i] += -(LEARN_RATE(net)*net->layer[j].gradient[i]); 597 | net->layer[j].delta[i] += -(LEARN_RATE(net)*net->layer[j].pgradient[i])*MOMENTUM(net); 598 | net->layer[j].pgradient[i] = net->layer[j].gradient[i]; 599 | } 600 | } 601 | } 602 | 603 | /* Update the sgradient, that's the sum of the weight's gradient for every 604 | * element of the training set. This is used for the RPROP algorithm 605 | * that works with the sign of the derivative for the whole set. */ 606 | void AnnUpdateSgradient(struct Ann *net) 607 | { 608 | int j, i, layers = LAYERS(net); 609 | 610 | for (j = 1; j < layers; j++) { 611 | int units = UNITS(net, j); 612 | int weights = units * UNITS(net,j-1); 613 | for (i = 0; i < weights; i++) 614 | net->layer[j].sgradient[i] += net->layer[j].gradient[i]; 615 | } 616 | } 617 | 618 | /* Adjust net weights using the (already) calculated deltas. */ 619 | void AnnAdjustWeights(struct Ann *net) 620 | { 621 | int j, i, layers = LAYERS(net); 622 | 623 | for (j = 1; j < layers; j++) { 624 | int units = UNITS(net, j); 625 | int weights = units * UNITS(net,j-1); 626 | for (i = 0; i < weights; i++) { 627 | net->layer[j].weight[i] += net->layer[j].delta[i]; 628 | } 629 | } 630 | } 631 | 632 | /* Batch Gradient Descend Epoch */ 633 | double AnnBatchGDEpoch(struct Ann *net, double *input, double *desidered, int setlen) 634 | { 635 | double maxerr = 0, e; 636 | int j, inputs = INPUT_UNITS(net), outputs = OUTPUT_UNITS(net); 637 | 638 | AnnResetDeltas(net); 639 | for (j = 0; j < setlen; j++) { 640 | e = AnnSimulateError(net, input, desidered); 641 | if (e > maxerr) maxerr = e; 642 | AnnCalculateGradients(net, desidered); 643 | AnnUpdateDeltasGD(net); 644 | input += inputs; 645 | desidered += outputs; 646 | } 647 | AnnAdjustWeights(net); 648 | return maxerr; 649 | } 650 | 651 | /* Batch Gradient Descend Epoch with Momentum */ 652 | double AnnBatchGDMEpoch(struct Ann *net, double *input, double *desidered, int setlen) 653 | { 654 | double maxerr = 0, e; 655 | int j, inputs = INPUT_UNITS(net), outputs = OUTPUT_UNITS(net); 656 | 657 | AnnResetDeltas(net); 658 | for (j = 0; j < setlen; j++) { 659 | e = AnnSimulateError(net, input, desidered); 660 | if (e > maxerr) maxerr = e; 661 | AnnCalculateGradients(net, desidered); 662 | AnnUpdateDeltasGDM(net); 663 | input += inputs; 664 | desidered += outputs; 665 | } 666 | AnnAdjustWeights(net); 667 | return maxerr; 668 | } 669 | 670 | /* Helper function for RPROP, returns -1 if n < 0, +1 if n > 0, 0 if n == 0 */ 671 | double sign(double n) 672 | { 673 | if (n > 0) return +1; 674 | if (n < 0) return -1; 675 | return 0; 676 | } 677 | 678 | /* The core of the RPROP algorithm. 679 | * 680 | * Note that: 681 | * sgradient is the set-wise gradient. 682 | * delta is the per-weight update value. */ 683 | void AnnAdjustWeightsResilientBP(struct Ann *net) 684 | { 685 | int j, i, layers = LAYERS(net); 686 | 687 | for (j = 1; j < layers; j++) { 688 | int units = UNITS(net, j); 689 | int weights = units * UNITS(net,j-1); 690 | for (i = 0; i < weights; i++) { 691 | double t = net->layer[j].pgradient[i] * 692 | net->layer[j].sgradient[i]; 693 | if (t > 0) { 694 | net->layer[j].delta[i] = 695 | MIN(net->layer[j].delta[i]*RPROP_NPLUS(net), 696 | RPROP_MAXUPDATE(net)); 697 | net->layer[j].weight[i] -= 698 | sign(net->layer[j].sgradient[i]) * 699 | net->layer[j].delta[i]; 700 | net->layer[j].pgradient[i] = 701 | net->layer[j].sgradient[i]; 702 | } else if (t < 0) { 703 | net->layer[j].delta[i] = 704 | MAX(net->layer[j].delta[i]*RPROP_NMINUS(net), 705 | RPROP_MINUPDATE(net)); 706 | net->layer[j].pgradient[i] = 0; 707 | } else { 708 | net->layer[j].weight[i] -= 709 | sign(net->layer[j].sgradient[i]) * 710 | net->layer[j].delta[i]; 711 | net->layer[j].pgradient[i] = 712 | net->layer[j].sgradient[i]; 713 | } 714 | } 715 | } 716 | } 717 | 718 | /* Resilient Backpropagation Epoch */ 719 | double AnnResilientBPEpoch(struct Ann *net, double *input, double *desidered, int setlen) 720 | { 721 | double maxerr = 0, e; 722 | int j, inputs = INPUT_UNITS(net), outputs = OUTPUT_UNITS(net); 723 | 724 | AnnResetSgradient(net); 725 | for (j = 0; j < setlen; j++) { 726 | e = AnnSimulateError(net, input, desidered); 727 | if (e > maxerr) maxerr = e; 728 | AnnCalculateGradients(net, desidered); 729 | AnnUpdateSgradient(net); 730 | input += inputs; 731 | desidered += outputs; 732 | } 733 | AnnAdjustWeightsResilientBP(net); 734 | return maxerr; 735 | } 736 | 737 | /* Train the net */ 738 | int AnnTrain(struct Ann *net, double *input, double *desidered, double maxerr, int maxepochs, int setlen) 739 | { 740 | int i = 0; 741 | double e = maxerr+1; 742 | int algo = net->flags & ANN_ALGOMASK; 743 | 744 | while (i++ < maxepochs && e >= maxerr) { 745 | switch(algo) { 746 | case ANN_RPROP: 747 | e = AnnResilientBPEpoch(net, input, desidered, setlen); 748 | break; 749 | case ANN_OBPROP: /* fixme, for now use the batch mode */ 750 | case ANN_BBPROP: 751 | e = AnnBatchGDEpoch(net, input, desidered, setlen); 752 | break; 753 | case ANN_OBPROPM: /* fixme, for now use the batch mode */ 754 | case ANN_BBPROPM: 755 | e = AnnBatchGDMEpoch(net, input, desidered, setlen); 756 | break; 757 | } 758 | } 759 | if (i >= maxepochs) 760 | return 0; 761 | return i; 762 | } 763 | 764 | #ifdef TESTMAIN 765 | int main(void) 766 | { 767 | struct Ann *net; 768 | double input[2] = {0.2, 0.3}; 769 | double inputa[] = {.1,.9,.9,.1,.1,.1,.9,.9}; 770 | double desida[] = {.9,.9,.1,.1}; 771 | double desidered[] = {0.8}; 772 | double e = 1; 773 | int c = 0; 774 | 775 | net = AnnCreateNet3(2, 3, 1); 776 | LEARN_RATE(net)=.1; 777 | if (!net) exit(1); 778 | srand(time(NULL)); 779 | AnnSetRandomWeights(net); 780 | AnnSetDeltas(net, RPROP_INITIAL_DELTA); 781 | { 782 | int x = 100000; 783 | int j; 784 | while (x-- && e > 0.000000000001) { 785 | //e = AnnBatchGDMEpoch(net, inputa, desida, 4); 786 | e = AnnResilientBPEpoch(net, inputa, desida, 4); 787 | c++; 788 | } 789 | for (j = 0; j < 4; j++) { 790 | AnnSimulateError(net, inputa+j*2, desida+j); 791 | AnnPrint(net); 792 | printf("-----------------------\n"); 793 | } 794 | } 795 | printf("Max error: %.9f (at epoch %d)\n", e, c); 796 | { 797 | struct Ann *t = AnnClone(net); 798 | AnnPrint(t); 799 | } 800 | Ann2Tcl(net); 801 | AnnFree(net); 802 | return 0; 803 | } 804 | #endif 805 | -------------------------------------------------------------------------------- /nn.h: -------------------------------------------------------------------------------- 1 | #ifndef __NN_H 2 | #define __NN_H 3 | 4 | /* Data structures. 5 | * Nets are not so 'dynamic', but enough to support 6 | * an arbitrary number of layers, with arbitrary units for layer. 7 | * Only fully connected feed-forward networks are supported. */ 8 | struct AnnLayer { 9 | int units; 10 | double *output; /* output[i], output of i-th unit */ 11 | double *error; /* error[i], output error of i-th unit*/ 12 | double *weight; /* weight[(i*units)+j] */ 13 | /* weight between unit i-th and next j-th */ 14 | double *gradient; /* gradient[(i*units)+j] gradient */ 15 | double *pgradient; /* pastgradient[(i*units)+j] t-1 gradient */ 16 | /* (t-1 sgradient for resilient BP) */ 17 | double *delta; /* delta[(i*units)+j] cumulative update */ 18 | /* (per-weight delta for RPROP) */ 19 | double *sgradient; /* gradient for the full training set */ 20 | /* only used for RPROP */ 21 | }; 22 | 23 | /* Feed forward network structure */ 24 | struct Ann { 25 | int flags; 26 | int layers; 27 | double learn_rate; 28 | double momentum; 29 | double rprop_nminus; 30 | double rprop_nplus; 31 | double rprop_maxupdate; 32 | double rprop_minupdate; 33 | struct AnnLayer *layer; 34 | }; 35 | 36 | /* Kohonen network structure (SOM) */ 37 | struct Konet2d { 38 | int xnet; 39 | int ynet; 40 | int inputlen; 41 | double **weight; 42 | double *value; 43 | double learn_rate; 44 | double neighborhood; 45 | }; 46 | 47 | /* Raw interface to data structures */ 48 | #define OUTPUT(net,l,i) (net)->layer[l].output[i] 49 | #define ERROR(net,l,i) (net)->layer[l].error[i] 50 | #define WEIGHT(net,l,i,j) (net)->layer[l].weight[((i)*(net)->layer[l-1].units)+(j)] 51 | #define GRADIENT(net,l,i,j) (net)->layer[l].gradient[((i)*(net)->layer[l-1].units)+(j)] 52 | #define SGRADIENT(net,l,i,j) (net)->layer[l].sgradient[((i)*(net)->layer[l-1].units)+(j)] 53 | #define PGRADIENT(net,l,i,j) (net)->layer[l].pgradient[((i)*(net)->layer[l-1].units)+(j)] 54 | #define DELTA(net,l,i,j) (net)->layer[l].delta[((i)*(net)->layer[l-1].units)+(j)] 55 | #define LAYERS(net) (net)->layers 56 | #define UNITS(net,l) (net)->layer[l].units 57 | #define WEIGHTS(net,l) (UNITS(net,l)*UNITS(net,l-1)) 58 | #define LEARN_RATE(net) (net)->learn_rate 59 | #define MOMENTUM(net) (net)->momentum 60 | #define OUTPUT_NODE(net,i) OUTPUT(net,0,i) 61 | #define INPUT_NODE(net,i) OUTPUT(net,((net)->layers)-1,i) 62 | #define OUTPUT_UNITS(net) UNITS(net,0) 63 | #define INPUT_UNITS(net) (UNITS(net,((net)->layers)-1)-(LAYERS(net)>2)) 64 | #define RPROP_NMINUS(net) (net)->rprop_nminus 65 | #define RPROP_NPLUS(net) (net)->rprop_nplus 66 | #define RPROP_MAXUPDATE(net) (net)->rprop_maxupdate 67 | #define RPROP_MINUPDATE(net) (net)->rprop_minupdate 68 | 69 | /* Constants */ 70 | #define DEFAULT_LEARN_RATE 0.1 71 | #define DEFAULT_MOMENTUM 0.6 72 | #define DEFAULT_RPROP_NMINUS 0.5 73 | #define DEFAULT_RPROP_NPLUS 1.2 74 | #define DEFAULT_RPROP_MAXUPDATE 50 75 | #define DEFAULT_RPROP_MINUPDATE 0.000001 76 | #define RPROP_INITIAL_DELTA 0.1 77 | 78 | /* Flags */ 79 | #define ANN_BBPROP (1 << 0) /* standard batch backprop */ 80 | #define ANN_OBPROP (1 << 1) /* online backprop */ 81 | #define ANN_BBPROPM (1 << 2) /* standard batch backprop with momentum */ 82 | #define ANN_OBPROPM (1 << 3) /* online backprop with momentum */ 83 | #define ANN_RPROP (1 << 4) /* resilient backprop (batch) */ 84 | #define ANN_ALGOMASK (ANN_BBPROP|ANN_OBPROP|ANN_BBPROPM|ANN_OBPROPM|ANN_RPROP) 85 | 86 | /* Misc */ 87 | #define MAX(a,b) (((a)>(b))?(a):(b)) 88 | #define MIN(a,b) (((a)<(b))?(a):(b)) 89 | 90 | /* Prototypes */ 91 | void AnnResetLayer(struct AnnLayer *layer); 92 | struct Ann *AnnAlloc(int layers); 93 | void AnnFreeLayer(struct AnnLayer *layer); 94 | void AnnFree(struct Ann *net); 95 | int AnnInitLayer(struct Ann *net, int i, int units, int bias); 96 | struct Ann *AnnCreateNet(int layers, int *units); 97 | struct Ann *AnnCreateNet3(int iunits, int hunits, int ounits); 98 | struct Ann *AnnCreateNet4(int iunits, int hunits, int hunits2, int ounits); 99 | struct Ann *AnnClone(struct Ann* net); 100 | void AnnSimulate(struct Ann *net); 101 | void Ann2Tcl(struct Ann *net); 102 | void AnnPrint(struct Ann *net); 103 | double AnnGlobalError(struct Ann *net, double *desidered); 104 | void AnnSetInput(struct Ann *net, double *input); 105 | double AnnSimulateError(struct Ann *net, double *input, double *desidered); 106 | void AnnCalculateGradientsTrivial(struct Ann *net, double *desidered); 107 | void AnnCalculateGradients(struct Ann *net, double *desidered); 108 | void AnnSetDeltas(struct Ann *net, double val); 109 | void AnnResetDeltas(struct Ann *net); 110 | void AnnResetSgradient(struct Ann *net); 111 | void AnnSetRandomWeights(struct Ann *net); 112 | void AnnScaleWeights(struct Ann *net, double factor); 113 | void AnnUpdateDeltasGD(struct Ann *net); 114 | void AnnUpdateDeltasGDM(struct Ann *net); 115 | void AnnUpdateSgradient(struct Ann *net); 116 | void AnnAdjustWeights(struct Ann *net); 117 | double AnnBatchGDEpoch(struct Ann *net, double *input, double *desidered, int setlen); 118 | double AnnBatchGDMEpoch(struct Ann *net, double *input, double *desidered, int setlen); 119 | void AnnAdjustWeightsResilientBP(struct Ann *net); 120 | double AnnResilientBPEpoch(struct Ann *net, double *input, double *desidered, int setlen); 121 | void AnnSetLearningAlgo(struct Ann *net, int algoid); 122 | int AnnTrain(struct Ann *net, double *input, double *desidered, double maxerr, int maxepochs, int setlen); 123 | 124 | #endif /* __NN_H */ 125 | -------------------------------------------------------------------------------- /papers/Masalmah_Yahya2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/papers/Masalmah_Yahya2.pdf -------------------------------------------------------------------------------- /peppers-scaled.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/peppers-scaled.pgm -------------------------------------------------------------------------------- /peppers.pgm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/antirez/nn-2003/9b527c15a708bce58ff2f934b7c8de57534ee2fc/peppers.pgm -------------------------------------------------------------------------------- /tclgnegnu.c: -------------------------------------------------------------------------------- 1 | /* Tcl bindings for gnegnu neural networks. 2 | * Copyright (C) 2003 Salvatore Sanfilippo 3 | * All rights reserved. 4 | * 5 | * See LICENSE for Copyright and License information. */ 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include "nn.h" 12 | 13 | #define VERSION "0.1" 14 | 15 | /* -------------------------- ANN object implementation --------------------- */ 16 | 17 | static void Tcl_SetAnnObj(Tcl_Obj *objPtr, struct Ann *srcnet); 18 | static void FreeAnnInternalRep(Tcl_Obj *objPtr); 19 | static void DupAnnInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); 20 | static void UpdateStringOfAnn(Tcl_Obj *objPtr); 21 | static int SetAnnFromAny(struct Tcl_Interp* interp, Tcl_Obj *objPtr); 22 | 23 | struct Tcl_ObjType tclAnnType = { 24 | "ann", 25 | FreeAnnInternalRep, 26 | DupAnnInternalRep, 27 | UpdateStringOfAnn, 28 | SetAnnFromAny 29 | }; 30 | 31 | /* This function set objPtr as an ann object with value 32 | * 'val'. If 'val' == NULL, the object is set to an empty net. */ 33 | void Tcl_SetAnnObj(Tcl_Obj *objPtr, struct Ann *srcnet) 34 | { 35 | Tcl_ObjType *typePtr; 36 | struct Ann *net; 37 | 38 | /* It's not a good idea to set a shared object... */ 39 | if (Tcl_IsShared(objPtr)) { 40 | panic("Tcl_SetMpzObj called with shared object"); 41 | } 42 | /* Free the old object private data and invalidate the string 43 | * representation. */ 44 | typePtr = objPtr->typePtr; 45 | if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 46 | (*typePtr->freeIntRepProc)(objPtr); 47 | } 48 | Tcl_InvalidateStringRep(objPtr); 49 | /* Allocate and initialize a new neural network */ 50 | if (srcnet) { 51 | net = AnnClone(srcnet); 52 | } else { 53 | net = AnnAlloc(0); 54 | } 55 | if (!net) { 56 | panic("Out of memory in Tcl_SetAnnObj"); 57 | } 58 | /* Set it as object private data, and type */ 59 | objPtr->typePtr = &tclAnnType; 60 | objPtr->internalRep.otherValuePtr = (void*) net; 61 | } 62 | 63 | /* Return an ANN from the object. If the object is not of type ANN 64 | * an attempt to convert it to ANN is done. On failure (the string 65 | * representation of the object can't be converted to a neural net) 66 | * an error is returned. */ 67 | int Tcl_GetAnnFromObj(struct Tcl_Interp *interp, Tcl_Obj *objPtr, struct Ann **annpp) 68 | { 69 | int result; 70 | 71 | if (objPtr->typePtr != &tclAnnType) { 72 | result = SetAnnFromAny(interp, objPtr); 73 | if (result != TCL_OK) 74 | return result; 75 | } 76 | *annpp = (struct Ann*) objPtr->internalRep.longValue; 77 | return TCL_OK; 78 | } 79 | 80 | /* The 'free' method of the object. */ 81 | void FreeAnnInternalRep(Tcl_Obj *objPtr) 82 | { 83 | struct Ann* net= (struct Ann*) objPtr->internalRep.otherValuePtr; 84 | 85 | AnnFree(net); 86 | } 87 | 88 | /* The 'dup' method of the object */ 89 | void DupAnnInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) 90 | { 91 | struct Ann *annCopyPtr, *annSrcPtr; 92 | 93 | annSrcPtr = (struct Ann*) srcPtr->internalRep.otherValuePtr; 94 | if ((annCopyPtr = AnnClone(annSrcPtr)) == NULL) 95 | panic("Out of memory inside DupMpzInternalRep()"); 96 | copyPtr->internalRep.otherValuePtr = (void*) annCopyPtr; 97 | copyPtr->typePtr = &tclAnnType; 98 | } 99 | 100 | /* Helper function for UpdateStringOfAnn() function */ 101 | static void StrAppendListDouble(char **pptr, double *v, int len) 102 | { 103 | char *b = *pptr; 104 | int i; 105 | 106 | *b++ = '{'; 107 | if (v) { 108 | for (i = 0; i < len; i++) { 109 | char aux[64]; 110 | int l; 111 | 112 | sprintf(aux, "%.16f ", v[i]); 113 | l = strlen(aux); 114 | memcpy(b, aux, l); 115 | b += l; 116 | *b++ = ' '; 117 | } 118 | } 119 | *b++ = '}'; 120 | *b++ = ' '; 121 | *pptr = b; 122 | } 123 | 124 | /* The 'update string' method of the object */ 125 | void UpdateStringOfAnn(Tcl_Obj *objPtr) 126 | { 127 | struct Ann *net = (struct Ann*) objPtr->internalRep.otherValuePtr; 128 | double aux[6]; 129 | size_t len = 0; 130 | char *b, *algostr; 131 | int j; 132 | 133 | /* Guess how many bytes are needed for the representation */ 134 | for (j = 0; j < LAYERS(net); j++) { 135 | int units = UNITS(net,j); 136 | int weights; 137 | weights = j == 0 ? 0 : WEIGHTS(net,j); 138 | /* output and error array */ 139 | len += 2 * 24 * units; 140 | /* weight, gradient, pgradient, delta, sgradient */ 141 | len += 5 * 24 * weights; 142 | /* list delimiters and spaces */ 143 | len += 8 * 3; 144 | } 145 | len += (6 * 24) + 5; /* Final list of parameters */ 146 | len += 64; /* flags */ 147 | objPtr->bytes = ckalloc(len); 148 | b = (char *) objPtr->bytes; 149 | /* Convert to string */ 150 | for (j = 0; j < LAYERS(net); j++) { 151 | int units = UNITS(net,j); 152 | int weights; 153 | weights = j == 0 ? 0 : WEIGHTS(net,j); 154 | *b++ = '{'; 155 | StrAppendListDouble(&b, net->layer[j].output, units); 156 | StrAppendListDouble(&b, net->layer[j].error, units); 157 | StrAppendListDouble(&b, net->layer[j].weight, weights); 158 | StrAppendListDouble(&b, net->layer[j].gradient, weights); 159 | StrAppendListDouble(&b, net->layer[j].pgradient, weights); 160 | StrAppendListDouble(&b, net->layer[j].delta, weights); 161 | StrAppendListDouble(&b, net->layer[j].sgradient, weights); 162 | *b++ = '}'; 163 | *b++ = ' '; 164 | } 165 | /* Net configuration */ 166 | *b++ = '{'; 167 | aux[0] = net->learn_rate; 168 | aux[1] = net->momentum; 169 | aux[2] = net->rprop_nminus; 170 | aux[3] = net->rprop_nplus; 171 | aux[4] = net->rprop_maxupdate; 172 | aux[5] = net->rprop_minupdate; 173 | StrAppendListDouble(&b, aux, 6); 174 | *b++ = '}'; 175 | *b++ = ' '; 176 | /* Net flags */ 177 | switch(net->flags & ANN_ALGOMASK) { 178 | case ANN_BBPROP: algostr = "bbprop"; break; 179 | case ANN_OBPROP: algostr = "obprop"; break; 180 | case ANN_BBPROPM: algostr = "bbpropm"; break; 181 | case ANN_OBPROPM: algostr = "obpropm"; break; 182 | case ANN_RPROP: algostr = "rprop"; break; 183 | default: algostr = "unknown"; break; 184 | } 185 | memcpy(b, algostr, strlen(algostr)); 186 | b += strlen(algostr); 187 | *b = '\0'; 188 | objPtr->length = strlen(objPtr->bytes); 189 | } 190 | 191 | /* The 'set from any' method of the object */ 192 | int SetAnnFromAny(struct Tcl_Interp* interp, Tcl_Obj *objPtr) 193 | { 194 | #if 0 195 | char *s; 196 | mpz_t t; 197 | mpz_ptr mpzPtr; 198 | Tcl_ObjType *typePtr; 199 | 200 | if (objPtr->typePtr == &tclMpzType) 201 | return TCL_OK; 202 | 203 | /* Try to convert */ 204 | s = Tcl_GetStringFromObj(objPtr, NULL); 205 | mpz_init(t); 206 | if (mpz_set_str(t, s, 0) != SBN_OK) { 207 | mpz_clear(t); 208 | Tcl_ResetResult(interp); 209 | Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 210 | "Invalid big number: \"", 211 | s, "\" must be a relative integer number", 212 | NULL); 213 | return TCL_ERROR; 214 | } 215 | /* Allocate */ 216 | mpzPtr = (mpz_ptr) ckalloc(sizeof(struct struct_sbnz)); 217 | mpz_init(mpzPtr); 218 | /* Free the old object private rep */ 219 | typePtr = objPtr->typePtr; 220 | if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 221 | (*typePtr->freeIntRepProc)(objPtr); 222 | } 223 | /* Set it */ 224 | objPtr->typePtr = &tclMpzType; 225 | objPtr->internalRep.otherValuePtr = (void*) mpzPtr; 226 | memcpy(mpzPtr, t, sizeof(*mpzPtr)); 227 | return TCL_OK; 228 | #endif 229 | Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 230 | "SetAnnFromAny() not implemented", NULL); 231 | return TCL_ERROR; 232 | } 233 | 234 | /* --------------- the actual commands for multipreicision math ------------- */ 235 | 236 | #if 0 237 | static int BigBasicObjCmd(ClientData clientData, Tcl_Interp *interp, 238 | int objc, Tcl_Obj *CONST objv[]) 239 | { 240 | Tcl_Obj *result; 241 | mpz_t res; 242 | mpz_ptr t; 243 | char *cmd; 244 | 245 | cmd = Tcl_GetStringFromObj(objv[0], NULL); 246 | objc--; 247 | objv++; 248 | 249 | result = Tcl_GetObjResult(interp); 250 | mpz_init(res); 251 | mpz_setzero(res); 252 | if (cmd[0] == '*' || cmd[0] == '/') { 253 | if (mpz_set_ui(res, 1) != SBN_OK) 254 | goto err; 255 | } 256 | if ((cmd[0] == '/' || cmd[0] == '%' || cmd[0] == '-') && objc) { 257 | if (Tcl_GetMpzFromObj(interp, objv[0], &t) != TCL_OK) 258 | goto err; 259 | if (mpz_set(res, t) != SBN_OK) 260 | goto oom; 261 | if (cmd[0] == '-' && objc == 1) 262 | res->s = !res->s; 263 | objc--; 264 | objv++; 265 | } 266 | while(objc--) { 267 | if (Tcl_GetMpzFromObj(interp, objv[0], &t) != TCL_OK) 268 | goto err; 269 | switch(cmd[0]) { 270 | case '+': 271 | if (mpz_add(res, res, t) != SBN_OK) 272 | goto oom; 273 | break; 274 | case '-': 275 | if (mpz_sub(res, res, t) != SBN_OK) 276 | goto oom; 277 | break; 278 | case '*': 279 | if (mpz_mul(res, res, t) != SBN_OK) 280 | goto oom; 281 | break; 282 | case '/': 283 | if (mpz_tdiv_q(res, res, t) != SBN_OK) 284 | goto oom; 285 | break; 286 | case '%': 287 | if (mpz_mod(res, res, t) != SBN_OK) 288 | goto oom; 289 | break; 290 | } 291 | objv++; 292 | } 293 | Tcl_SetMpzObj(result, res); 294 | mpz_clear(res); 295 | return TCL_OK; 296 | err: 297 | mpz_clear(res); 298 | return TCL_ERROR; 299 | oom: 300 | Tcl_SetStringObj(result, "Out of memory doing multiprecision math", -1); 301 | mpz_clear(res); 302 | return TCL_ERROR; 303 | } 304 | 305 | static int BigCmpObjCmd(ClientData clientData, Tcl_Interp *interp, 306 | int objc, Tcl_Obj *CONST objv[]) 307 | { 308 | Tcl_Obj *result; 309 | mpz_ptr a, b; 310 | int cmp, res; 311 | char *cmd; 312 | 313 | if (objc != 3) { 314 | Tcl_WrongNumArgs(interp, 1, objv, "bignum bignum"); 315 | return TCL_ERROR; 316 | } 317 | 318 | cmd = Tcl_GetStringFromObj(objv[0], NULL); 319 | if (Tcl_GetMpzFromObj(interp, objv[1], &a) != TCL_OK || 320 | Tcl_GetMpzFromObj(interp, objv[2], &b) != TCL_OK) 321 | return TCL_ERROR; 322 | cmp = mpz_cmp(a, b); 323 | 324 | result = Tcl_GetObjResult(interp); 325 | res = 0; 326 | switch(cmd[0]) { 327 | case '>': 328 | switch(cmd[1]) { 329 | case '=': 330 | if (cmp >= 0) res = 1; 331 | break; 332 | default: 333 | if (cmp > 0) res = 1; 334 | break; 335 | } 336 | break; 337 | case '<': 338 | switch(cmd[1]) { 339 | case '=': 340 | if (cmp <= 0) res = 1; 341 | break; 342 | default: 343 | if (cmp < 0) res = 1; 344 | break; 345 | } 346 | break; 347 | case '=': 348 | if (cmp == 0) res = 1; 349 | break; 350 | case '!': 351 | if (cmp != 0) res = 1; 352 | break; 353 | } 354 | Tcl_SetIntObj(result, res); 355 | return TCL_OK; 356 | } 357 | 358 | static int BigRandObjCmd(ClientData clientData, Tcl_Interp *interp, 359 | int objc, Tcl_Obj *CONST objv[]) 360 | { 361 | Tcl_Obj *result; 362 | int len = 1; 363 | mpz_t r; 364 | 365 | if (objc != 1 && objc != 2) { 366 | Tcl_WrongNumArgs(interp, 1, objv, "?atoms?"); 367 | return TCL_ERROR; 368 | } 369 | if (objc == 2 && Tcl_GetIntFromObj(interp, objv[1], &len) != TCL_OK) 370 | return TCL_ERROR; 371 | result = Tcl_GetObjResult(interp); 372 | mpz_init(r); 373 | if (mpz_random(r, len) != SBN_OK) { 374 | mpz_clear(r); 375 | Tcl_SetStringObj(result, "Out of memory", -1); 376 | return TCL_ERROR; 377 | } 378 | Tcl_SetMpzObj(result, r); 379 | mpz_clear(r); 380 | return TCL_OK; 381 | } 382 | 383 | static int BigSrandObjCmd(ClientData clientData, Tcl_Interp *interp, 384 | int objc, Tcl_Obj *CONST objv[]) 385 | { 386 | char *seed; 387 | int len; 388 | 389 | if (objc != 2) { 390 | Tcl_WrongNumArgs(interp, 1, objv, "seed-string"); 391 | return TCL_ERROR; 392 | } 393 | seed = Tcl_GetStringFromObj(objv[1], &len); 394 | sbn_seed(seed, len); 395 | return TCL_OK; 396 | } 397 | 398 | static int BigPowObjCmd(ClientData clientData, Tcl_Interp *interp, 399 | int objc, Tcl_Obj *CONST objv[]) 400 | { 401 | Tcl_Obj *result; 402 | int mpzerr; 403 | mpz_t r; /* result */ 404 | mpz_ptr b, e, m; /* base, exponent, modulo */ 405 | 406 | if (objc != 3 && objc != 4) { 407 | Tcl_WrongNumArgs(interp, 1, objv, "base exponent ?modulo?"); 408 | return TCL_ERROR; 409 | } 410 | if (Tcl_GetMpzFromObj(interp, objv[1], &b) != TCL_OK || 411 | Tcl_GetMpzFromObj(interp, objv[2], &e) != TCL_OK || 412 | (objc == 4 && Tcl_GetMpzFromObj(interp, objv[3], &m) != TCL_OK)) 413 | return TCL_ERROR; 414 | result = Tcl_GetObjResult(interp); 415 | mpz_init(r); 416 | if (objc == 4) 417 | mpzerr = mpz_powm(r, b, e, m); 418 | else 419 | mpzerr = mpz_pow(r, b, e); 420 | if (mpzerr != SBN_OK) { 421 | mpz_clear(r); 422 | if (mpzerr == SBN_INVAL) 423 | Tcl_SetStringObj(result, "Negative exponent", -1); 424 | else 425 | Tcl_SetStringObj(result, "Out of memory", -1); 426 | return TCL_ERROR; 427 | } 428 | Tcl_SetMpzObj(result, r); 429 | mpz_clear(r); 430 | return TCL_OK; 431 | } 432 | 433 | static int BigSqrtObjCmd(ClientData clientData, Tcl_Interp *interp, 434 | int objc, Tcl_Obj *CONST objv[]) 435 | { 436 | Tcl_Obj *result; 437 | int mpzerr; 438 | mpz_t r; /* result */ 439 | mpz_ptr z; /* input number for the square root */ 440 | 441 | if (objc != 2) { 442 | Tcl_WrongNumArgs(interp, 1, objv, "number"); 443 | return TCL_ERROR; 444 | } 445 | if (Tcl_GetMpzFromObj(interp, objv[1], &z) != TCL_OK) 446 | return TCL_ERROR; 447 | result = Tcl_GetObjResult(interp); 448 | mpz_init(r); 449 | mpzerr = mpz_sqrt(r, z); 450 | if (mpzerr != SBN_OK) { 451 | mpz_clear(r); 452 | Tcl_SetStringObj(result, "Out of memory", -1); 453 | return TCL_ERROR; 454 | } 455 | Tcl_SetMpzObj(result, r); 456 | mpz_clear(r); 457 | return TCL_OK; 458 | } 459 | #endif 460 | 461 | static int AnnCreateObjCmd(ClientData clientData, Tcl_Interp *interp, 462 | int objc, Tcl_Obj *CONST objv[]) 463 | { 464 | Tcl_Obj *result; 465 | int *units = alloca(sizeof(int)*objc-1), i; 466 | struct Ann *net; 467 | 468 | if (objc < 3) { 469 | Tcl_WrongNumArgs(interp, 1, objv, "OutputUnits ?HiddenUnits1 HiddenUnits2 ...? InputUnits"); 470 | return TCL_ERROR; 471 | } 472 | /* Initialize the units vector used to create the net */ 473 | for (i = 1; i < objc; i++) { 474 | if (Tcl_GetIntFromObj(interp, objv[i], &units[i-1]) != TCL_OK) { 475 | return TCL_ERROR; 476 | } 477 | } 478 | /* Create the neural net */ 479 | result = Tcl_GetObjResult(interp); 480 | if ((net = AnnCreateNet(objc-1, units)) == NULL) { 481 | Tcl_SetStringObj(result, "Out of memory", -1); 482 | return TCL_ERROR; 483 | } 484 | Tcl_SetAnnObj(result, net); 485 | AnnFree(net); 486 | return TCL_OK; 487 | } 488 | 489 | static int AnnSimulateObjCmd(ClientData clientData, Tcl_Interp *interp, 490 | int objc, Tcl_Obj *CONST objv[]) 491 | { 492 | struct Ann *net; 493 | Tcl_Obj *varObj, *result; 494 | int len, j; 495 | 496 | if (objc != 3) { 497 | Tcl_WrongNumArgs(interp, 1, objv, "AnnVar InputList"); 498 | return TCL_ERROR; 499 | } 500 | varObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); 501 | if (!varObj) 502 | return TCL_ERROR; 503 | if (Tcl_ListObjLength(interp, objv[2], &len) != TCL_OK) 504 | return TCL_ERROR; 505 | /* Get the neural network object */ 506 | if (Tcl_GetAnnFromObj(interp, varObj, &net) != TCL_OK) 507 | return TCL_ERROR; 508 | /* Check if the len matches */ 509 | if (len != INPUT_UNITS(net)) { 510 | Tcl_SetStringObj(Tcl_GetObjResult(interp), "The input list length doesn't match the number of inputs in the neural network", -1); 511 | return TCL_ERROR; 512 | } 513 | /* Set the list elements as the neural net inputs */ 514 | for (j = 0; j < INPUT_UNITS(net); j++) { 515 | Tcl_Obj *element; 516 | double d; 517 | 518 | if (Tcl_ListObjIndex(interp, objv[2], j, &element) != TCL_OK) 519 | return TCL_ERROR; 520 | if (Tcl_GetDoubleFromObj(interp, element, &d) != TCL_OK) 521 | return TCL_ERROR; 522 | INPUT_NODE(net, j) = d; 523 | } 524 | /* Simulate! */ 525 | AnnSimulate(net); 526 | Tcl_InvalidateStringRep(varObj); 527 | /* Return a list with the output units values */ 528 | result = Tcl_GetObjResult(interp); 529 | Tcl_SetListObj(result, 0, NULL); 530 | for (j = 0; j < OUTPUT_UNITS(net); j++) { 531 | Tcl_Obj *doubleObj; 532 | doubleObj = Tcl_NewDoubleObj(OUTPUT_NODE(net,j)); 533 | Tcl_ListObjAppendElement(interp, result, doubleObj); 534 | } 535 | return TCL_OK; 536 | } 537 | 538 | static int AnnConfigureObjCmd(ClientData clientData, Tcl_Interp *interp, 539 | int objc, Tcl_Obj *CONST objv[]) 540 | { 541 | struct Ann *net; 542 | Tcl_Obj *varObj; 543 | int j; 544 | 545 | if (objc < 4 || objc % 2) { 546 | Tcl_WrongNumArgs(interp, 1, objv, "AnnVar Option Value ?Option Value? ..."); 547 | return TCL_ERROR; 548 | } 549 | varObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); 550 | if (!varObj) 551 | return TCL_ERROR; 552 | /* Get the neural network object */ 553 | if (Tcl_GetAnnFromObj(interp, varObj, &net) != TCL_OK) 554 | return TCL_ERROR; 555 | Tcl_InvalidateStringRep(varObj); 556 | /* process all the option/value pairs */ 557 | for (j = 2; j < objc; j += 2) { 558 | char *opt = Tcl_GetStringFromObj(objv[j], NULL); 559 | double dval; 560 | 561 | if (!strcmp(opt, "-learnrate")) { 562 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 563 | != TCL_OK) 564 | return TCL_ERROR; 565 | LEARN_RATE(net) = dval; 566 | } else if (!strcmp(opt, "-momentum")) { 567 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 568 | != TCL_OK) 569 | return TCL_ERROR; 570 | MOMENTUM(net) = dval; 571 | } else if (!strcmp(opt, "-rpropnminus")) { 572 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 573 | != TCL_OK) 574 | return TCL_ERROR; 575 | RPROP_NMINUS(net) = dval; 576 | } else if (!strcmp(opt, "-rpropnplus")) { 577 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 578 | != TCL_OK) 579 | return TCL_ERROR; 580 | RPROP_NPLUS(net) = dval; 581 | } else if (!strcmp(opt, "-rpropmaxupdate")) { 582 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 583 | != TCL_OK) 584 | return TCL_ERROR; 585 | RPROP_MAXUPDATE(net) = dval; 586 | } else if (!strcmp(opt, "-rpropminupdate")) { 587 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 588 | != TCL_OK) 589 | return TCL_ERROR; 590 | RPROP_MINUPDATE(net) = dval; 591 | } else if (!strcmp(opt, "-algo")) { 592 | char *algo = Tcl_GetStringFromObj(objv[j+1], NULL); 593 | int algoid = 0; 594 | if (!strcmp(algo, "rprop")) { 595 | algoid = ANN_RPROP; 596 | } else if (!strcmp(algo, "bbprop")) { 597 | algoid = ANN_BBPROP; 598 | } else if (!strcmp(algo, "obprop")) { 599 | algoid = ANN_OBPROP; 600 | } else if (!strcmp(algo, "bbpropm")) { 601 | algoid = ANN_BBPROPM; 602 | } else if (!strcmp(algo, "obpropm")) { 603 | algoid = ANN_OBPROPM; 604 | } else { 605 | Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 606 | "unknown algorithm '", algo, "'", NULL); 607 | return TCL_ERROR; 608 | } 609 | AnnSetLearningAlgo(net, algoid); 610 | } else if (!strcmp(opt, "-scale")) { 611 | if (Tcl_GetDoubleFromObj(interp, objv[j+1], &dval) 612 | != TCL_OK) 613 | return TCL_ERROR; 614 | AnnScaleWeights(net, dval); 615 | } else { 616 | Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 617 | "unknown configuration option '", opt,"'",NULL); 618 | return TCL_ERROR; 619 | } 620 | } 621 | return TCL_OK; 622 | } 623 | 624 | /* ann::train annVar datasetListValue maxEpochs ?maxError? */ 625 | static int AnnTrainObjCmd(ClientData clientData, Tcl_Interp *interp, 626 | int objc, Tcl_Obj *CONST objv[]) 627 | { 628 | struct Ann *net; 629 | Tcl_Obj *varObj; 630 | int j, maxepochs, setlen; 631 | double maxerr = 0, *input = NULL, *target = NULL, *ip, *tp; 632 | 633 | if (objc != 4 && objc != 5) { 634 | Tcl_WrongNumArgs(interp, 1, objv, "AnnVar DataSetListValue MaxEpochs ?MaxError?"); 635 | return TCL_ERROR; 636 | } 637 | varObj = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); 638 | if (!varObj) 639 | return TCL_ERROR; 640 | /* Get the neural network object */ 641 | if (Tcl_GetAnnFromObj(interp, varObj, &net) != TCL_OK) 642 | return TCL_ERROR; 643 | Tcl_InvalidateStringRep(varObj); 644 | /* Extract parameters from Tcl objects */ 645 | if (Tcl_GetIntFromObj(interp, objv[3], &maxepochs) != TCL_OK) 646 | return TCL_ERROR; 647 | if (objc == 5 && Tcl_GetDoubleFromObj(interp, objv[4], &maxerr) != TCL_OK) 648 | return TCL_ERROR; 649 | if (Tcl_ListObjLength(interp, objv[2], &setlen) != TCL_OK) 650 | return TCL_ERROR; 651 | if (setlen % 2) { 652 | Tcl_SetStringObj(Tcl_GetObjResult(interp), "The dataset list requires an even number of elements", -1); 653 | return TCL_ERROR; 654 | } 655 | /* Convert the dataset from a Tcl list to two C arrays of doubles. */ 656 | ip = input = malloc(INPUT_UNITS(net)*sizeof(double)*(setlen/2)); 657 | tp = target = malloc(OUTPUT_UNITS(net)*sizeof(double)*(setlen/2)); 658 | if (!input || !target) { 659 | free(input); 660 | free(target); 661 | Tcl_SetStringObj(Tcl_GetObjResult(interp), 662 | "Out of memory in AnnLearnObjCmd()", -1); 663 | return TCL_ERROR; 664 | } 665 | for (j = 0; j < setlen; j++) { 666 | int l, explen, i; 667 | Tcl_Obj *sublist; 668 | 669 | if (Tcl_ListObjIndex(interp, objv[2], j, &sublist) != TCL_OK) 670 | return TCL_ERROR; 671 | if (Tcl_ListObjLength(interp, sublist, &l) != TCL_OK) 672 | return TCL_ERROR; 673 | explen = (j&1) ? OUTPUT_UNITS(net) : INPUT_UNITS(net); 674 | if (l != explen) { 675 | free(input); 676 | free(target); 677 | Tcl_SetStringObj(Tcl_GetObjResult(interp), 678 | "Dataset doesn't match input/output units", -1); 679 | return TCL_ERROR; 680 | } 681 | /* Append the data to one of the arrays */ 682 | for (i = 0; i < l; i++) { 683 | Tcl_Obj *element; 684 | double t; 685 | 686 | if (Tcl_ListObjIndex(interp, sublist, i, &element) 687 | != TCL_OK || 688 | Tcl_GetDoubleFromObj(interp, element, &t) 689 | != TCL_OK) 690 | { 691 | free(input); 692 | free(target); 693 | return TCL_ERROR; 694 | } 695 | if (j&1) 696 | *tp++ = t; 697 | else 698 | *ip++ = t; 699 | } 700 | } 701 | /* Training */ 702 | j = AnnTrain(net, input, target, maxerr, maxepochs, setlen/2); 703 | free(input); 704 | free(target); 705 | Tcl_SetIntObj(Tcl_GetObjResult(interp), j); 706 | return TCL_OK; 707 | } 708 | 709 | /* ------------------------------- Initialization -------------------------- */ 710 | int Tclgnegnu_Init(Tcl_Interp *interp) 711 | { 712 | if (Tcl_InitStubs(interp, "8.0", 0) == NULL) 713 | return TCL_ERROR; 714 | if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) 715 | return TCL_ERROR; 716 | if (Tcl_PkgProvide(interp, "tclgnegnu", VERSION) != TCL_OK) 717 | return TCL_ERROR; 718 | Tcl_Eval(interp, "namespace eval ann {}"); 719 | Tcl_CreateObjCommand(interp, "ann::create", AnnCreateObjCmd, 720 | (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL); 721 | Tcl_CreateObjCommand(interp, "ann::simulate", AnnSimulateObjCmd, 722 | (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL); 723 | Tcl_CreateObjCommand(interp, "ann::configure", AnnConfigureObjCmd, 724 | (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL); 725 | Tcl_CreateObjCommand(interp, "ann::train", AnnTrainObjCmd, 726 | (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL); 727 | /* Private data initialization here */ 728 | return TCL_OK; 729 | } 730 | -------------------------------------------------------------------------------- /test.tcl: -------------------------------------------------------------------------------- 1 | load tclgnegnu.so 2 | set net [ann::create 42 2 42] 3 | ann::configure net -algo rprop 4 | set img1 { 5 | 0 0 0 0 0 0 0 6 | 0 0 1 1 1 0 0 7 | 0 1 0 0 0 1 0 8 | 0 1 0 0 0 1 0 9 | 0 0 1 1 1 0 0 10 | 0 0 0 0 0 0 0 11 | } 12 | 13 | set img2 { 14 | 1 0 0 0 0 0 1 15 | 1 1 0 1 1 1 0 16 | 1 1 1 1 0 0 0 17 | 1 1 1 1 0 0 0 18 | 1 1 0 1 1 1 0 19 | 1 0 0 0 0 0 1 20 | } 21 | 22 | 23 | set dataset [list $img1 $img1 $img2 $img2] 24 | 25 | proc print img { 26 | set i 0 27 | for {set j 0} {$j < [llength $img]} {incr j} { 28 | if {[lindex $img $j] > 0.5} { 29 | puts -nonewline "#" 30 | } else { 31 | puts -nonewline "." 32 | } 33 | if {!(($j+1) % 7)} { 34 | puts {} 35 | } 36 | } 37 | } 38 | 39 | print $img1 40 | print $img2 41 | 42 | puts [ann::train net $dataset 40] 43 | 44 | set output [ann::simulate net $img1] 45 | print $output 46 | set output [ann::simulate net $img2] 47 | print $output 48 | --------------------------------------------------------------------------------