001: #!/usr/bin/perl -w
002: #!/usr/bin/perl -d:ptkdb -w
003: #
004: 
005: use strict;
006: 
007: 
008: BEGIN
009: {
010:     #! make check
011: 
012:     push @INC, '../perl';
013: 
014:     #! make distcheck
015: 
016:     push @INC, '../../perl';
017: 
018:     #! normal run
019: 
020:     push @INC, './perl';
021: 
022:     #! after install
023: 
024:     push @INC, '/usr/local/glue/swig/perl';
025: }
026: 
027: 
028: use Getopt::Long;
029: 
030: use YAML;
031: 
032: 
033: my $global_operators
034:     = {
035:        average =>
036:        sub
037:        {
038:            #t need to add stddev.
039: 
040:            my ($description, $final_value, $descendant, $parameter, $value) = @_;
041: 
042:            my $count = 0;
043: 
044:            if (defined $description)
045:            {
046:                $description =~ /([0-9]+)/;
047: 
048:                $count = $1;
049:            }
050: 
051:            $count++;
052: 
053:            (!defined $final_value) && ($final_value = $value);
054: 
055: #           print ("\naverage of $count value(s)", $final_value, ' ', $value, ' ', $final_value - ($final_value - $value) / $count);
056: 
057:            return ("average of $count value(s)", $final_value - ($final_value - $value) / $count);
058:        },
059:        cumulate =>
060:        sub
061:        {
062:            my ($description, $final_value, $descendant, $parameter, $value) = @_;
063: 
064:            return ('cumulated value', ($final_value || 0) + $value);
065:        },
066:        length_average =>
067:        sub
068:        {
069:            my ($description, $final_value, $descendant, $parameter, $value) = @_;
070: 
071:            my $length
072:                = SwiggableNeurospaces::symbol_parameter_resolve_value
073:                    ($descendant->{_symbol},
074:                     $descendant->{_context},
075:                     "LENGTH",
076:                    );
077: 
078:            if ($value != $SwiggableNeurospaces::dFLT_MAX)
079:            {
080:                my $count = 0;
081: 
082:                if (defined $description)
083:                {
084:                    $description =~ /([0-9]+)/;
085: 
086:                    $count = $1;
087:                }
088: 
089:                $count++;
090: 
091:                (!defined $final_value) && ($final_value = 0);
092: 
093:                return ("average of $count value(s)", $final_value + $value * $length / $count);
094:            }
095:        },
096:        maximum =>
097:        sub
098:        {
099:            my ($description, $final_value, $descendant, $parameter, $value) = @_;
100: 
101:            !defined $final_value && return("$descendant->{context}->$parameter", $value);
102: 
103:            return $final_value >= $value ? ($description, $final_value) : ("$descendant->{context}->$parameter", $value);
104:        },
105:        minimum =>
106:        sub
107:        {
108:            my ($description, $final_value, $descendant, $parameter, $value) = @_;
109: 
110:            !defined $final_value && return("$descendant->{context}->$parameter", $value);
111: 
112:            return $final_value <= $value ? ($description, $final_value) : ("$descendant->{context}->$parameter", $value);
113:        },
114:       };
115: 
116: my $operator_results = {};
117: 
118: 
119: use Data::Dumper;
120: 
121: 
122: # {
123: #     no strict "refs";
124: 
125: #     print Dumper(\%{"main::"});
126: 
127: #     print "Found these methods for Neurospaces::\n";
128: 
129: #     print Dumper(\%{"Neurospaces::"});
130: 
131: #     print "Found these methods for Neurospaces::Traversal::\n";
132: 
133: #     print Dumper(\%{"Neurospaces::Traversal::"});
134: 
135: #     print "Found these methods for SwiggableNeurospaces::\n";
136: 
137: #     print Dumper(\%{"SwiggableNeurospaces::"});
138: 
139: #     print "Found these methods for SwiggableNeurospaces::PidinStack::\n";
140: 
141: #     print Dumper(\%{"SwiggableNeurospaces::PidinStack::"});
142: 
143: #     print "Found these methods for SwiggableNeurospaces::descr_Segment::\n";
144: 
145: #     print Dumper(\%{"SwiggableNeurospaces::descr_Segment::"});
146: 
147: #     print "Found these methods for SwiggableNeurospaces::symtab_Segment::\n";
148: 
149: #     print Dumper(\%{"SwiggableNeurospaces::symtab_Segment::"});
150: 
151: #     print "Found these methods for SwiggableNeurospaces::symtab_BioComponent::\n";
152: 
153: #     print Dumper(\%{"SwiggableNeurospaces::symtab_BioComponent::"});
154: 
155: #     print "Found these methods for SwiggableNeurospaces::Symbols::\n";
156: 
157: #     print Dumper(\%{"SwiggableNeurospaces::Symbols::"});
158: 
159: # }
160: 
161: 
162: # use Neurospaces_embed;
163: 
164: 
165: BEGIN
166: {
167:     $SIG{__DIE__}
168:         = sub {
169:             use Carp;
170: 
171:             confess @_;
172:         };
173: }
174: 
175: 
176: my $option_algorithm;
177: my $option_backend_options = [];
178: my $option_commands = [];
179: my $option_condition = [];
180: my $option_force_library;
181: my $option_gui;
182: my $option_interactive;
183: my $option_models = '/usr/local/neurospaces/models/library';
184: my $option_no_use_library;
185: my $option_operators = [];
186: our $option_protocol;
187: my $option_querymachine;
188: my $option_render = [];
189: my $option_reporting_fields = [];
190: my $option_scaling;
191: my $option_show;
192: my $option_shrinkage_correction;
193: my $option_spine_prototypes = [];
194: my $option_traversal_symbol;
195: my $option_type;
196: our $option_verbose;
197: 
198: 
199: sub main
200: {
201:     read_cmd_line();
202: 
203:     #! for proper error reporting of loading modules (Renderer etc),
204:     #! 'require' must be used, not 'use'.
205: 
206:     require Neurospaces;
207:     require Neurospaces::Traversal;
208:     require Neurospaces::Studio;
209: 
210:     my $neurospaces = Neurospaces->new();
211: 
212:     # my $args = [ "$0", "-q", "cells/golgi.ndf" ];
213: 
214:     my $args = [ "$0", ];
215: 
216:     if ($option_models)
217:     {
218:         $ENV{NEUROSPACES_NMC_MODELS} = $option_models;
219:     }
220: 
221:     if ($option_querymachine)
222:     {
223:         push @$args, '-q';
224:     }
225: 
226: #     push @$args, @ARGV;
227: 
228:     my $success
229:         = $neurospaces->load
230:             (
231:              undef,
232:              {
233:               'backend_options' => $option_backend_options,
234:               'commands' => $option_commands,
235:               'force-library' => $option_force_library,
236:               'filename' => $ARGV[0],
237:               (defined $option_no_use_library) ? ('no-use-library' => $option_no_use_library) : (),
238:               (defined $option_shrinkage_correction) ? ('shrinkage' => $option_shrinkage_correction) : (),
239:               'spine-prototypes' => $option_spine_prototypes,
240:              },
241:              $args,
242:             );
243: 
244:     if ($option_interactive)
245:     {
246:         #t not sure yet, should be perhaps based on the perl shell ?
247:     }
248: 
249:     # load additional data to render before opening the gui
250: 
251:     if (@$option_render)
252:     {
253:         require Neurospaces::GUI::Tools::Renderer::External;
254: 
255:         foreach my $external (@$option_render)
256:         {
257:             Neurospaces::GUI::Tools::Renderer::External::load($external);
258:         }
259:     }
260: 
261:     if ($option_show)
262:     {
263:         my $d3renderer = $Neurospaces::Studio::d3renderer;
264: 
265:         if (!$d3renderer)
266:         {
267:             print STDERR "d3renderer is not initialized (value is $d3renderer)\n";
268:         }
269:         else
270:         {
271:             my $morphology_name = $ARGV[0];
272: 
273:             $morphology_name =~ s/.*\///;
274: 
275:             $morphology_name =~ s/\.swc$//i;
276:             $morphology_name =~ s/\.p$//i;
277: 
278:             $morphology_name =~ s/\./_/g;
279: 
280:             my $symbol_name = "/$morphology_name/$option_show";
281: 
282:             my $serial = $option_show;
283: 
284:             my $studio = Neurospaces::Studio->new();
285: 
286:             require Neurospaces::GUI;
287:             my $symbol = Neurospaces::GUI::Components::Node::factory( { serial => $serial, studio => $studio, }, );
288: 
289:             $d3renderer->symbols_clear();
290: 
291:             $d3renderer->symbol_add($symbol);
292: 
293:             $d3renderer->start();
294:         }
295: 
296:         # force to have a quit button
297: 
298:         $option_gui = 1;
299:     }
300: 
301:     if ($option_gui)
302:     {
303:         require Neurospaces::GUI;
304:         Neurospaces::GUI::gui($0);
305:     }
306: 
307: #     my $d3renderer = $Neurospaces::Studio::d3renderer;
308: 
309: #     if ($d3renderer)
310: #     {
311: #        $d3renderer->start();
312: #     }
313: 
314:     # from here on, go through the options alphabetically
315: 
316:     if ($option_algorithm)
317:     {
318:         $neurospaces->algorithm_instance_report($option_algorithm);
319:     }
320: 
321:     if ($option_traversal_symbol)
322:     {
323:         my $symbol;
324:         my $parameters = [];
325:         my $operator_names = [];
326: 
327:         #! never use this functionality, avoid shell quoting issues,
328:         #! use the field options instead.
329: 
330:         if (0 && $option_traversal_symbol =~ /^([^-]+)->(.+)$/)
331:         {
332:             $symbol = $1;
333:             $parameters = [ $2, ];
334:         }
335:         else
336:         {
337:             $symbol = $option_traversal_symbol;
338:         }
339: 
340:         if (@$option_reporting_fields)
341:         {
342:             $parameters = $option_reporting_fields;
343:         }
344: 
345:         if (@$option_operators)
346:         {
347:             $operator_names = $option_operators;
348:         }
349: 
350:         if (!@$parameters)
351:         {
352:             print "---\npaths:\n";
353:         }
354:         elsif (!@$option_operators)
355:         {
356:             print "---\nparameters:\n";
357:         }
358: 
359:         my $traversal
360:             = Neurospaces::Traversal->new
361:                 (
362:                  {
363:                   context => $symbol,
364:                   processor =>
365:                   sub
366:                   {
367:                       my $self = shift;
368: 
369:                       my $descendant = shift;
370: 
371:                       my $d = $descendant;
372: 
373:                       if ($option_type)
374:                       {
375:                           if ($descendant->{type} !~ /$option_type/)
376:                           {
377:                               return 1;
378:                           }
379:                       }
380: 
381:                       if (@$option_condition)
382:                       {
383:                           foreach my $condition (@$option_condition)
384:                           {
385:                               my $value = eval $condition;
386: 
387:                               if ($@)
388:                               {
389:                                   die $@;
390:                               }
391: 
392:                               if (!$value)
393:                               {
394:                                   return 1;
395:                               }
396:                           }
397:                       }
398: 
399:                       if (@$parameters)
400:                       {
401:                           foreach my $parameter (@$parameters)
402:                           {
403:                               my $value;
404: 
405:                               if ($option_scaling)
406:                               {
407:                                   $value
408:                                       = SwiggableNeurospaces::symbol_parameter_resolve_scaled_value
409:                                           (
410:                                            $descendant->{_symbol},
411:                                            $descendant->{_context},
412:                                            $parameter,
413:                                           );
414:                               }
415:                               else
416:                               {
417:                                   $value
418:                                       = SwiggableNeurospaces::symbol_parameter_resolve_value
419:                                           (
420:                                            $descendant->{_symbol},
421:                                            $descendant->{_context},
422:                                            $parameter,
423:                                           );
424:                               }
425: 
426:                               if (@$operator_names)
427:                               {
428:                                   foreach my $operator_name (@$operator_names)
429:                                   {
430:                                       my $operator = $global_operators->{$operator_name};
431: 
432:                                       if (!defined $operator)
433:                                       {
434:                                           die "$0: $operator_name is not defined";
435:                                       }
436: 
437:                                       if (ref $operator eq 'CODE')
438:                                       {
439:                                           my $description = $operator_results->{$operator_name}->{description};
440:                                           my $final_value = $operator_results->{$operator_name}->{final_value};
441: 
442:                                           ($description, $final_value) = &$operator($description, $final_value, $descendant, $parameter, $value);
443: 
444:                                           if (!defined $final_value)
445:                                           {
446:                                               die "$0: $operator_name returned an error condition";
447:                                           }
448: 
449:                                           $operator_results->{$operator_name}->{description} = $description;
450:                                           $operator_results->{$operator_name}->{final_value} = $final_value;
451:                                       }
452:                                       else
453:                                       {
454:                                           die "$0: $operator_name is not a CODE reference";
455:                                       }
456:                                   }
457:                               }
458:                               else
459:                               {
460:                                   if ($value != $SwiggableNeurospaces::dFLT_MAX)
461:                                   {
462:                                       print "  '" . $descendant->{context} . "->" . $parameter . "': " . $value . "\n";
463:                                   }
464:                               }
465:                           }
466:                       }
467:                       else
468:                       {
469:                           print "  - $descendant->{context}\n";
470:                       }
471: 
472:                       return 1;
473:                   },
474:                   neurospaces => $neurospaces,
475:                  },
476:                 );
477: 
478:         my $success = $traversal->go();
479: 
480:         if (!$success)
481:         {
482:             print STDERR "Traversal failed\n";
483:         }
484:         else
485:         {
486:             if (@$operator_names)
487:             {
488:                 foreach my $operator_name (sort @$operator_names)
489:                 {
490:                     my $description = $operator_results->{$operator_name}->{description};
491:                     my $final_value = $operator_results->{$operator_name}->{final_value};
492: 
493:                     print "---\n$operator_name:
494:   description: $description
495:   final_value: $final_value\n";
496:                 }
497:             }
498:         }
499:     }
500: 
501: 
502: }
503: 
504: 
505: sub read_cmd_line
506: {
507:     my $option_help;
508:     my $option_version;
509: 
510:     my $result
511:         = GetOptions
512:             (
513:              "algorithm=s" => \$option_algorithm,
514:              "backend-options=s" => $option_backend_options,
515:              "commands=s" => $option_commands,
516:              "condition=s" => $option_condition,
517:              "force-library!" => \$option_force_library,
518:              "gui!" => \$option_gui,
519:              "help!" => \$option_help,
520:              "interactive!" => \$option_interactive,
521:              "models=s" => \$option_models,
522:              "no-use-library!" => \$option_no_use_library,
523:              "operators=s" => $option_operators,
524:              "protocol=s" => \$option_protocol,
525:              "query!" => \$option_querymachine,
526:              "render=s" => $option_render,
527:              "reporting-fields=s" => $option_reporting_fields,
528:              "scaling!" => \$option_scaling,
529:              "show=s" => \$option_show,
530:              "shrinkage-correction=s" => \$option_shrinkage_correction,
531:              "spine-prototypes=s" => $option_spine_prototypes,
532:              "traversal-symbol=s" => \$option_traversal_symbol,
533:              "type=s" => \$option_type,
534:              "v|verbose+" => \$option_verbose,
535:              "version" => \$option_version,
536:             );
537: 
538:     if ($option_version)
539:     {
540:         my $version = version();
541: 
542:         print $version . "\n";
543: 
544:         exit 1;
545:     }
546: 
547:     if ($option_help || @ARGV eq 0)
548:     {
549:         print
550:             "
551: $0 <model-filename>
552: 
553: $0: parse a model description, interact with the model.
554: 
555: options :
556:     --algorithm              report on an algorithm instance.
557:     --backend-options        options to pass to the neurospaces backend.
558:     --commands               execute these query machine commands after loading a file.
559:     --condition              a (perl) condition to apply, where applicable.
560:     --force-library          force the use of library values for morphology2ndf.
561:     --gui                    enter the gui.
562:     --help                   print usage information.
563:     --interactive            enter interactive mode.
564:     --models                 directory where to find the neurospaces library (default is $option_models).
565:     --no-use-library         do not use the library with specific settings for each morphology.
566:     --operators              apply these operators to each reported field.
567:     --protocol               protocol used to do color coding of morphologies.
568:     --query                  enter the query machine after parsing.
569:     --render                 render a file, using a renderer plugin.
570:     --reporting-fields       report these fields during traversing (use multiple options to report multiple fields).
571:     --scaling                apply scaling to the reported parameter values,
572:                              can be used in combination with cumulate.
573:     --show                   find and show this component in the renderer.
574:     --shrinkage-correction   shrinkage correction
575:                              NOTE: this is only applied when loading files that need conversion,
576:                              it is not applied when reading ndf files.
577:     --spine-prototypes       add spines with this prototype
578:     --traversal-symbol       symbol to traverse.
579:     --type                   type to traverse
580:     --verbose                set verbosity level.
581:     --version                give version information.
582: ";
583: 
584:         exit 1;
585:     }
586: }
587: 
588: 
589: sub version
590: {
591:     # $Format: "    my $version=\"${package}-${label}\";"$
592:     my $version="studio-python-5";
593: 
594:     return $version;
595: }
596: 
597: 
598: main();
599: 
600: