AI-NeuralNet-FastSOM
view release on metacpan or search on metacpan
if ( !(mg = selfmagic(self)) )
croak("self has no magic!\n");
som = self2somptr(self,mg);
X = som->X;
Y = som->Y;
i = X*Y;
Newx(n,i,NV);
for ( i-=1 ; i>=0 ; i-- )
n[i] = -1;
if ( som->type == SOMType_Torus )
neiguts = _torus_neiguts;
else if ( som->type == SOMType_Hexa )
neiguts = _hexa_neiguts;
else if ( som->type == SOMType_Rect )
neiguts = _rect_neiguts;
else
croak("unknown type");
neiguts(som,sigma,X0,Y0,n);
neighbors = newAV();
for ( x=0 ; x<X ; x++ ) {
for ( y=0 ; y<Y ; y++ ) {
distance = n[x*Y+y];
if ( distance >= 0 ) {
tmp = newAV();
av_push(tmp,newSViv(x));
av_push(tmp,newSViv(y));
av_push(tmp,newSVnv(distance));
av_push(neighbors,newRV_noinc((SV*)tmp));
}
}
}
Safefree(n);
return neighbors;
}
SOM_Vector* _make_vector(SOM_Array* array) {
IV z,len;
AV *thingy;
SV *tie;
HV *stash;
SOM_Vector *vector;
z = array->Z;
len = sizeof(SOM_Vector)+z*sizeof(NV);
Newxc(vector, len, char, SOM_Vector);
Zero(vector, len, char);
vector->Z = z;
thingy = newAV();
tie = newRV_noinc(newSViv(PTR2IV(vector)));
stash = gv_stashpv("AI::NeuralNet::FastSOM::VECTOR", GV_ADD);
sv_bless(tie, stash);
hv_magic((HV*)thingy, (GV*)tie, 'P');
vector->ref = newRV_noinc((SV*)thingy);
(&vector->element)[z] = 0.0;
for ( z-=1 ; z>=0 ; z-- ) {
(&vector->element)[z] = 0.0;
}
return vector;
}
SOM_Array* _make_array(SOM_Map* map) {
IV y,len;
AV *thingy;
SV *tie;
HV *stash;
SOM_Array *array;
y = map->Y;
len = sizeof(SOM_Array)+y*sizeof(SOM_Vector*);
Newxc(array, len, char, SOM_Array);
Zero(array, len, char);
array->Y = y;
array->Z = map->Z;
thingy = newAV();
tie = newRV_noinc(newSViv(PTR2IV(array)));
stash = gv_stashpv("AI::NeuralNet::FastSOM::ARRAY", GV_ADD);
sv_bless(tie, stash);
hv_magic((HV*)thingy, (GV*)tie, PERL_MAGIC_tied);
array->ref = newRV_noinc((SV*)thingy);
(&array->vector)[y] = NULL;
for ( y-=1 ; y>=0 ; y-- )
(&array->vector)[y] = _make_vector( array );
return array;
}
SOM_Map* _make_map(SOM_GENERIC *som) {
IV x,len;
AV *thingy;
SV *tie;
HV *stash;
SOM_Map *map;
x = som->X;
len = sizeof(SOM_Map)+x*sizeof(SOM_Array*);
Newxc(map, len, char, SOM_Map);
Zero(map, len, char);
map->X = x;
map->Y = som->Y;
map->Z = som->Z;
thingy = newAV();
tie = newRV_noinc(newSViv(PTR2IV(map)));
stash = gv_stashpv("AI::NeuralNet::FastSOM::MAP", GV_ADD);
sv_bless(tie, stash);
hv_magic((HV*)thingy, (GV*)tie, PERL_MAGIC_tied);
map->ref = newRV_noinc((SV*)thingy);
(&map->array)[x] = NULL;
for ( x-=1 ; x>=0 ; x-- )
(&map->array)[x] = _make_array( map );
return map;
}
/*
* som functions
*/
void _som_bmu(SV* self, AV* sample) {
IV cx,cy;
NV cd;
MAGIC *mg;
SOM_GENERIC *som;
dXSARGS;
if ( !(mg = selfmagic(self)) )
croak("self has no magic!\n");
som = self2somptr(self,mg);
_bmuguts(som,sample,&cx,&cy,&cd);
PERL_UNUSED_VAR(items); /* -W */
sp = mark;
XPUSHs(sv_2mortal(newSViv(cx)));
XPUSHs(sv_2mortal(newSViv(cy)));
XPUSHs(sv_2mortal(newSVnv(cd)));
PUTBACK;
}
SV* _som_map(SV* self) {
MAGIC *mg;
SOM_GENERIC *som;
if ( !(mg = selfmagic(self)) )
croak("self has no magic!\n");
som = self2somptr(self,mg);
SvREFCNT_inc(som->map->ref);
return som->map->ref;
}
SV* _som_output_dim(SV* self) {
MAGIC *mg;
SOM_GENERIC *som;
if ( !(mg = selfmagic(self)) )
croak("self has no magic!\n");
som = self2somptr(self,mg);
SvREFCNT_inc(som->output_dim);
return som->output_dim;
}
}
}
else {
croak("i wanna run with scissors!");
}
} /* cloning */
PUTBACK;
}
void _som_THAW(SV* self,SV* cloning,SV* serialized) {
IV x,y,z,i;
SV *rrr;
HV *stash;
SOM_Map *m;
SOM_Array *a;
SOM_Vector *v;
SOM_GENERIC *som;
dXSARGS;
PERL_UNUSED_VAR(serialized); /* -W */
if (!SvTRUE(cloning)) {
if ( SvTYPE(SvRV(self)) == SVt_PVMG ) {
Newxz(som,1,SOM_GENERIC);
som->type = SvIV(SvRV(ST(3)));
som->X = SvIV(SvRV(ST(4)));
som->Y = SvIV(SvRV(ST(5)));
som->Z = SvIV(SvRV(ST(6)));
som->R = SvNV(SvRV(ST(7)));
som->Sigma0 = SvNV(SvRV(ST(8)));
som->L0 = SvNV(SvRV(ST(9)));
som->LAMBDA = SvNV(SvRV(ST(10)));
som->T = SvNV(SvRV(ST(11)));
som->output_dim = newSVsv(SvRV(ST(12)));
som->labels = (AV*)SvRV(ST(13));
som->map = _make_map( som );
i = 14;
m = som->map;
for ( x=som->X-1 ; x>=0 ; x-- ) {
a = (&m->array)[x];
for ( y=som->Y-1 ; y>=0 ; y-- ) {
v = (&a->vector)[y];
for ( z=som->Z-1 ; z>=0 ; z-- ) {
/*
(&v->element)[z] =
SvNV(SvRV(ST(i++)));
*/
rrr = SvRV(ST(i++));
(&v->element)[z] = SvNV(rrr);
}
}
}
SvSetSV( SvRV(self), sv_2mortal(newSViv((IV)PTR2IV(som))) );
stash = SvSTASH(SvRV(self));
som->ref = sv_bless(newRV_inc((SV*)self),stash);
}
else if ( SvTYPE(SvRV(self)) != SVt_PVHV )
croak("you'll put an eye out!");
} /* cloning */
PERL_UNUSED_VAR(items); /* -W */
sp = mark;
PUTBACK;
}
SV* _som_FETCH(SV* self,SV* key) {
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("map",3) ) ) ) {
SOM_GENERIC *som = INT2PTR(SOM_Rect*,self2iv(self));
SvREFCNT_inc(som->map->ref);
return som->map->ref;
}
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_X",2) ) ) )
return newSViv(tied2ptr(self)->X);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Y",2) ) ) )
return newSViv(tied2ptr(self)->Y);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Z",2) ) ) )
return newSViv(tied2ptr(self)->Z);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_R",2) ) ) )
return newSVnv(tied2ptr(self)->R);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_L0",3) ) ) )
return newSVnv(tied2ptr(self)->L0);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Sigma0",7) ) ) )
return newSVnv(tied2ptr(self)->Sigma0);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("output_dim",10) ) ) )
return newSVsv(tied2ptr(self)->output_dim);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("LAMBDA",6) ) ) )
return newSVnv(tied2ptr(self)->LAMBDA);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("T",1) ) ) )
return newSVnv(tied2ptr(self)->T);
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("labels",6) ) ) )
return newRV_inc((SV*)(tied2ptr(self)->labels));
croak("%s not accessible for read", SvPV_nolen(key));
}
SV* _som_STORE(SV* self,SV* key,SV* val) {
if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_X",2) ) ) )
tied2ptr(self)->X = SvIV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Y",2) ) ) )
tied2ptr(self)->Y = SvIV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Z",2) ) ) )
tied2ptr(self)->Z = SvIV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_R",2) ) ) )
tied2ptr(self)->R = SvNV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_L0",3) ) ) )
tied2ptr(self)->L0 = SvNV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("_Sigma0",7) ) ) )
tied2ptr(self)->Sigma0 = SvNV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("output_dim",10) ) ) )
tied2ptr(self)->output_dim = newSVsv(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("LAMBDA",6) ) ) )
tied2ptr(self)->LAMBDA = SvNV(val);
else if ( !sv_cmp( key, INT2PTR(SV*,newSVpvn("T",1) ) ) )
xstart = begptr;
if ( !isDIGIT((char)*xstart) )
croak("no x-dimension found");
som->X = Atol(xstart);
ystart = yend = endptr;
if ( !isDIGIT((char)*ystart) )
croak("no y-dimension found");
while (--ystart >= begptr)
if ( !isDIGIT((char)*ystart) )
break;
som->Y = Atol(++ystart);
som->Z = SvIV(*hv_fetch(options,"input_dim",9,FALSE));
som->R = som->X > som->Y
? som->Y / 2.0
: som->X / 2.0;
if ( hv_exists( options, "sigma0", 6 ) ) {
sigma0 = SvNV(*hv_fetch(options,"sigma0",6,0));
if ( sigma0 )
som->Sigma0 = sigma0;
else
som->Sigma0 = som->R;
}
else
som->Sigma0 = som->R;
if ( hv_exists( options, "learning_rate", 13 ) ) {
rate = SvNV(*hv_fetch(options,"learning_rate",13,0));
if ( rate )
som->L0 = rate;
else
som->L0 = 0.1;
}
else
som->L0 = 0.1;
som->map = _make_map(som);
som->labels = newAV();
sclass = sv_2mortal(newSVpvf("%s",class));
if (!sv_cmp(sclass,INT2PTR(
SV*,newSVpvn("AI::NeuralNet::FastSOM::Rect",28))))
som->type = SOMType_Rect;
/*
else if (!sv_cmp(sclass,INT2PTR(
SV*,newSVpvn("AI::NeuralNet::FastSOM::Hexa",28))))
som->type = SOMType_Hexa;
*/
else if (!sv_cmp(sclass,INT2PTR(
SV*,newSVpvn("AI::NeuralNet::FastSOM::Torus",29))))
som->type = SOMType_Torus;
else
croak("unknown type");
hash = (HV*)sv_2mortal((SV*)newHV());
tie = newRV_noinc(newSViv(PTR2IV(som)));
stash = gv_stashpv(class, GV_ADD);
sv_bless(tie, stash);
hv_magic(hash, (GV*)tie, PERL_MAGIC_tied);
rv = sv_bless(newRV_noinc((SV*)hash),stash);
som->ref = rv;
/*
* here 'hash' is the object seen from the perl side.
* 'tie' is what we see from the c side when accessing the tied
* functionality.
*/
sp = mark;
XPUSHs(rv);
PUTBACK;
}
SV* _rect_radius(SV* self) {
MAGIC *mg;
SOM_GENERIC *som;
if ( !(mg = selfmagic(self)) )
croak("self has no magic!\n");
som = self2somptr(self,mg);
return newSVnv(som->R);
}
/*
* torus functions
*/
void _torus_neiguts(SOM_Torus* som,NV sigma,IV X0,IV Y0,NV* n) {
IV x,y,X,Y;
NV d2,s2;
X = som->X;
Y = som->Y;
s2 = sigma * sigma;
for ( x=0 ; x<X ; x++ ) {
for ( y=0 ; y<Y ; y++ ) {
/*
* which one of these should "win"?
*/
d2 = (x-X0)*(x-X0) + (y-Y0)*(y-Y0);
if (d2 <= s2) n[x*Y+y] = sqrt(d2);
d2 = (x-X-X0)*(x-X-X0) + (y-Y0)*(y-Y0);
if (d2 <= s2) n[x*Y+y] = sqrt(d2);
d2 = (x+X-X0)*(x+X-X0) + (y-Y0)*(y-Y0);
if (d2 <= s2) n[x*Y+y] = sqrt(d2);
d2 = (x-X0)*(x-X0) + (y-Y-Y0)*(y-Y-Y0);
if (d2 <= s2) n[x*Y+y] = sqrt(d2);
d2 = (x-X0)*(x-X0) + (y+Y-Y0)*(y+Y-Y0);
HV *options,*hash,*stash;
STRLEN len;
SOM_Hexa *hexa;
dXSARGS;
if ( (items & 1) ^ 1 )
croak( "Weird number of arguments\n" );
options = newHV();
for ( i=1 ; i<items ; i+=2 ) {
key = ST(i);
val = ST(i+1);
len = sv_len(key);
hv_store( options, SvPV_nolen(key), len, val, 0 );
}
if ( !hv_exists( options, "input_dim", 9 ) )
croak( "no input_dim argument" );
if ( !hv_exists( options, "output_dim", 10 ) )
croak( "no ouput_dim argument" );
Newxz(hexa,1,SOM_Hexa);
od = newSVsv(*hv_fetch(options,"output_dim",10,FALSE));
hexa->output_dim = od;
hexa->X=SvIV(*hv_fetch(options,"output_dim",10,FALSE));
hexa->Z=SvIV(*hv_fetch(options,"input_dim",9,FALSE));
hexa->Y = hexa->X;
hexa->R = hexa->X / 2.0;
if ( hv_exists( options, "sigma0", 6 ) ) {
sigma0 = SvNV(*hv_fetch(options,"sigma0",6,0));
if ( sigma0 )
hexa->Sigma0 = sigma0;
else
hexa->Sigma0 = hexa->R;
}
else
hexa->Sigma0 = hexa->R;
if ( hv_exists( options, "learning_rate", 13 ) ) {
rate = SvNV(*hv_fetch(options,"learning_rate",13,0));
if ( rate )
hexa->L0 = rate;
else
hexa->L0 = 0.1;
}
else
hexa->L0 = 0.1;
hexa->map = _make_map( hexa );
hexa->labels = newAV();
hexa->type = SOMType_Hexa;
hash = (HV*)sv_2mortal((SV*)newHV());
tie = newRV_noinc(newSViv(PTR2IV(hexa)));
stash = gv_stashpv(class, GV_ADD);
sv_bless(tie, stash);
hv_magic(hash, (GV*)tie, PERL_MAGIC_tied);
rv = sv_bless(newRV_noinc((SV*)hash),stash);
hexa->ref = rv;
sp = mark;
XPUSHs(rv);
PUTBACK;
}
NV _hexa_distance(NV x1,NV y1,NV x2,NV y2) {
NV tmp,dx,dy;
if ( x1+y1 > x2+y2 ) {
tmp=x1; x1=x2; x2=tmp;
tmp=y1; y1=y2; y2=tmp;
}
dx = x2 - x1;
dy = y2 - y1;
if ( dx<0 || dy<0 )
return abs(dx) + abs(dy);
else
return dx<dy ? dy : dx;
}
void _hexa_neiguts(SOM_Hexa* som,NV sigma,IV X0,IV Y0,NV* n) {
IV x,y,X,Y;
NV d;
X = som->X;
Y = som->Y;
for ( x=0 ; x<X ; x++ ) {
for ( y=0 ; y<Y ; y++ ) {
d = _hexa_distance(X0,Y0,x,y);
if (d <= sigma) n[x*Y+y] = d;
}
}
}
/*
* map functions
*/
SV* _map_FETCH(SV* self,I32 x) {
SOM_Map *map;
SOM_Array *array;
map = INT2PTR(SOM_Map*,self2iv(self));
array = (&map->array)[x];
SvREFCNT_inc(array->ref);
return array->ref;
}
void _map_DESTROY(SV* self) {
SOM_Map *map;
map = INT2PTR(SOM_Map*,self2iv(self));
( run in 1.162 second using v1.01-cache-2.11-cpan-39bf76dae61 )