AI-MicroStructure
38 results

 view release on metacpan or  search on metacpan

lib/AI/MicroStructure.pm  view on Meta::CPAN 


 return $x;
}
sub import {
    my $class = shift;
    my @structures = ( grep { $_ eq ':all' } @_ )
      ? ( 'foo', grep { !/^(?:foo|:all)$/ } keys %MICRO  ) # 'foo' is still first
      : @_;
    $Structure = $structures[0] if @structures;
    $micro = AI::MicroStructure->new( $Structure );
    # export the microname() function
    no strict 'refs';
    my $callpkg = caller;
    *{"$callpkg\::microname"} = \&microname;    # standard theme
    # load the classes in @structures
    for my $structure( @structures ) {
        eval "require AI::MicroStructure::$structure; import AI::MicroStructure::$structure;";
        croak $@ if $@;
        *{"$callpkg\::micro$structure"} = sub { $micro->name( $structure, @_ ) };
    }
}
sub new {
    my ( $class, @args ) = ( @_ );
    my $structure;
    $structure = shift @args if @args % 2;
    $structure = $Structure unless $structure; # same default everywhere
    # defer croaking until name() is actually called
    bless { structure => $structure, args => { @args }, micro => {} ,state=>$state}, $class;
}
sub _rearrange{
   my $self = shift;
   $self->{'payload'} = shift if @_;
   return %$self;
}
# CLASS METHODS
sub add_structure {
   my $class  = shift;
   my %structures = @_;
   for my $structure ( keys %structures ) {
   croak "The structure $structure already exists!" if exists $MICRO{$structure};
   my @badnames = grep { !/^[a-z_]\w*$/i } @{$structures{$structure}};
   croak "Invalid names (@badnames) for structure $structure"
   if @badnames;
   my $code = << "EOC";
package AI::MicroStructure::$structure;
use strict;
use AI::MicroStructure::List;
our \@ISA = qw( AI::MicroStructure::List );
our \@List = qw( @{$structures{$structure}} );
__PACKAGE__->init();
1;
EOC
   eval $code;
   $MICRO{$structure} = 1; # loaded
   # export the microstructure() function
   no strict 'refs';
   my $callpkg = caller;
   *{"$callpkg\::micro$structure"} = sub { $micro->name( $structure, @_ ) };
   }
}
# load the content of __DATA__ into a structure
# this class method is used by the other AI::MicroStructure classes
sub load_data {
   my ($class, $structure ) = @_;
   $data = {};
   my $fh;
   { no strict 'refs'; $fh = *{"$structure\::DATA"}{IO}; }
   my $item;
   my @items;
   $$item = "";
   {
   if(defined($fh)){
   local $_;
   while (<$fh>) {
   /^#\s*(\w+.*)$/ && do {
   push @items, $item;
   $item = $data;
   my $last;
   my @keys = split m!\s+|\s*/\s*!, $1;
   $last = $item, $item = $item->{$_} ||= {} for @keys;
   $item = \( $last->{ $keys[-1] } = "" );
   next;
   };
   $$item .= $_;
   }
   }
}
   # clean up the items
   for( @items, $item ) {
   $$_ =~ s/\A\s*//;
   $$_ =~ s/\s*\z//;
   $$_ =~ s/\s+/ /g;
   }
   return $data;
}
#fitnes
sub fitnes {
    my $self = shift;
    return sha1_hex($self->structures());
   ##my ($config,$structure, $config ) = (shift,[$self->structures()]); FIXME
}
# main function
sub microname { $micro->name( @_ ) };
sub shitname {
    my $self = shift;
    my ( $structure, $count ) = ("any",1);
    if (@_) {
        ( $structure, $count ) = @_;
        ( $structure, $count ) = ( $self->{structure}, $structure )
          if $structure =~ /^(?:0|[1-9]\d*)$/;
    }
    else {
        ( $structure, $count ) = ( $self->{structure}, 1 );
    }
    if( ! exists $self->{micro}{$structure} ) {
        my ( $structure, $category ) = split /\//, $structure, 2;
        if( ! $MICRO{$structure}  ) {
            try{
#            `micro new $structure`;
            eval "require '$absstructdir/$structure.pm';";
            $MICRO{$structure} = 1; # loaded
            $self->{micro}{$structure}  = AI::MicroStructure->new($structure,category => $category);
            print $self->{micro}{$structure}->name( $count );
            return;
            }  catch{
            }
        }

lib/AI/MicroStructure.pm  view on Meta::CPAN 

   $all->{$key}=[$test->[1],$micro->name($items)];
}
 return $all;
}
sub save_cat {
  my $self = shift;
  my $data = shift;
  my $dat;
  my $ret = "";
  foreach my $key(sort keys %{$data} ) {
   next unless($_);
   #ref $hash->{$_} eq "HASH"
   if(ref $data->{$key} eq "HASH"){
   $ret .= "\n".$self->save_cat($data->{$key});
   }else{
   $dat = $data->{$key};
   $dat =~ s/^|,/\n/g;
   $dat =~ s/\n\n/\n/g;
   $dat =~ s/->\n|[0-9]\n//g;
   $ret .= "# ".($key=~/names|default|[a-z]/?$key:"names ".$key);
   $ret .= "\n ".$dat."\n";
   }
  }
  return $ret;
}
sub save_default {
  my $self = shift;
  my $data = shift;
  my $line = shift;
  my $dat = {};
  my @in = ();
  my $active=0;
  $line = $Structure unless($line);
  foreach(@{$data->{rows}->{"coordinate"}}){
   if($_ eq $line){ $active=1; }
   if(1+$line eq $_){ $active=0; }
   if($active==1){
   $_=~s/,//g;
   $_ = $self->trim($_);
   $dat->{names}->{$_}=$_ unless(defined($dat->{names}->{$_}));
   }
}
foreach(@{$data->{rows}->{"search"}}){
   if($_ eq $line){  $active=1; }
   if(1+$line eq $_){ $active=0; }
   if($active==1){
   $_=~s/,//g;
   $_ = $self->trim($_);
   $dat->{names}->{$_}=$_ unless(defined($dat->{names}->{$_}));
   }
}
push @in , keys %{$dat->{names}};
push @in , values %{$data->{names}};
$dat->{names} = join(" ",@in);
$dat->{names} =~ s/$line(.*?)\-\>(.*?) [1-9] /$1 $2/g;
$dat->{names} =~ s/  / /g;
my @file = grep{/$Structure/}map{File::Glob::bsd_glob(
 File::Spec->catfile( $_, ($structdir,"*.pm") ) )}@CWD;
  if(@file){
  open(SELF,"+<$file[0]") || die $!;
  while(<SELF>){last if /^__DATA__/}
   truncate(SELF,tell SELF);
   print SELF $self->save_cat($dat);
   truncate(SELF,tell SELF);
   close SELF;
  }
}
sub openData{
my $self = shift;
my @datax = ();
if(<DATA>){
@datax = <DATA>;
while(@datax){
  chomp;
  if($_=~/^#\s*(\w+.*)$/) {
   @a=split(" ",$1);
   if($#a){
   $data->{$a[0]}->{$a[1]}="";
   }else{
   $data->{$1}="";
   }
   $item=$1 unless($#a);
  }else{
   my @keys = split m!\s+|\s*/\s*!,$_;
   foreach(sort @keys){
   if($#a){
   $data->{$a[0]}->{$a[1]} .= " $_" unless($_ eq "");
   }else{
   $data->{$item} .= " $_" unless($_ eq "");
   }
   }
  };
}
}
return $data;
}
sub getBlank {
  my $self = shift;
  my $structure = shift;
  my $data = shift;
my $usage = "";
$usage = "#!/usr/bin/perl -W\n";
$usage .= << "EOC";
package AI::MicroStructure::$structure;
use strict;
use AI::MicroStructure::List;
our \@ISA = qw( AI::MicroStructure::List );
our \@List = qw( \@{\$structures{\$structure}} );
__PACKAGE__->init();
1;
EOC
my $new = {};
foreach my $k
(grep{!/^[0-9]/}map{$_=$self->trim($_)}@{$data->{rows}->{"search"}}){
   $k =~ s/[ ]/_/g;
   $k =~ s/[\(]|[\)]//g;
   next if($k=~/synonyms|hypernyms/);
   print $k;
   $new->{$k}=[map{$_=[map{$_=$self->trim($_)}split("\n|, ",$_)]}
      grep{!/synonyms|hypernyms/}split("sense~~~~~~~~~",
                                      lc `micro-wnet $k`)];
   next unless(@{$new->{$k}});
#   $new->{$k}=~s/Sense*\n(.*?)\n\n/$1/g;
#   @{$new->{$k}} = [split("\n|,",$new->{$k})];
   $data->{rows}->{"ident"}->{md5_base64($new->{$k})} = $new->{$k};
}
my $list = join("\n",sort keys %$new);
#   $list =~ s/_//g;
$usage .= "
__DATA__
# names
".$list;
}
sub save_new {
my $self = shift;
my $StructureName = shift;
my $data = shift;
    if($StructureName){
    #$StructureName = lc $self->trim(`micro`) unless($StructureName);
    my $file = "$absstructdir/$StructureName.pm";
    print `mkdir -p $absstructdir` unless(-d $absstructdir);
    my $fh;
    open($fh,">$file") || warn @{[$file,$!]};
    print $fh $self->getBlank($StructureName,$data);
    close $fh;
    $Structure = $StructureName;
    push @CWD,$file;
    return 1;
  }
}
sub drop {
my $self = shift;
my $StructureName = shift;
my @file = grep{/$StructureName.pm/}map{File::Glob::bsd_glob(
File::Spec->catfile( $_, ($structdir,"*.pm") ) )}@CWD;
my $fh = shift @file;
if(`ls $fh`)
{
print  `rm $fh`;
}
  #push @CWD,$file[1];
  return 1;
}
sub help{
}
END{
if($init){}
if($available){}
if($lib){}
if($list){
p @{[__PACKAGE__->getComponents]};
  }
if($use){}
if($off){}
if($switch){}
if($mirror){}
if($version){
    printf($VERSION);
    exit(0);
}
if($help) {
    printf(__PACKAGE__->help());
    exit(0);
}
if($drop == 1) {
   __PACKAGE__->drop($StructureName);
   exit 0;
}
if($new==1){
  use Term::ReadKey;

lib/AI/MicroStructure.pm  view on Meta::CPAN 

     /       `::.           """'  /             3>_
    /         `::.          ""   /              4>_
_.-d(          `:::.            F               5>_
-888b.          `::::.     .  J                 6>_
Y888888b.          `::::::::::'                 7>_
Y88888888bo.        `::::::d                    8>_
`"Y8888888888boo.._   `"dd88b.                  9>_
"""""""""""""""""""""""""""""""""""""""""""""""
EOT
$usage =~ s/<0>_/\033[0;32mThe word $search\033[255;34m/g;
$usage =~ s/<1>_/\033[0;32mhas $senseNr concept's\033[255;34m/g;
$usage =~ s/<2>_/\033[0;32mwe need to find out the which one\033[255;34m/g;
$usage =~ s/<3>_/\033[0;32mto use for our new,\033[255;34m/g;
$usage =~ s/<4>_/\033[0;32mmicro-structure,\033[255;34m/g;
$usage =~ s/<5>_//g;
my @row = ();
my $ii=0;
foreach my $sensnrx (sort keys %{$data->{"rows"}->{"senses"}})
{
   my $row = $data->{"rows"}->{"senses"}->{$sensnrx};
   my $txt="";
   foreach(@{$row->{"basics"}}[1..2]){
   next unless($_);
   $txt .= sprintf("\033[0;31m %s\033[255;34m",$_);
   }
   $txt .= sprintf("",$_);
   $usage =~ s/$sensnrx>_/($sensnrx):$txt/g;
   if($sensnrx>9){
   $usage .= sprintf("\n(%d):%s",$sensnrx,$txt);
   }
}
  foreach my $ii (0..16){
   $usage =~ s/$ii>_//g;
  }
return $usage;
}
1;
__END__
#print Dumper $micro;
# ABSTRACT: AI::MicroStructure   Creates Concepts for words
=head1 NAME
  AI::MicroStructure
=head1 DESCRIPTION
  Creates Concepts for words
=head1 SYNOPSIS
  ~$ micro new world
  ~$ micro structures
  ~$ micro any 2
  ~$ micro drop world
  ~$ micro
=head1 AUTHOR
  Hagen Geissler <santex@cpan.org>
=head1 COPYRIGHT AND LICENCE
  Hagen Geissler <santex@cpan.org>
=head1 SUPPORT AND DOCUMENTATION
 [sample using concepts](http://active-memory.de:2323/nerd?param=perl#ajax/home)
 [PDF info on my works](https://github.com/santex/AI-MicroStructure)
=head1 SEE ALSO
  AI-MicroStructure
=cut
__DATA__



( run in 0.652 second using v1.01-cache-2.11-cpan-140bd7fdf52 )