#!/usr/bin/perl use 5.014 ; use strict ; use warnings ; use Getopt::Std ; getopts '1g:m:s:' , \my %o ; use Term::ANSIColor qw[ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ; $o{m} //= 1 ; # 生æˆã™ã‚‹ãƒã‚¢ã‚½ãƒ³åˆ†å¸ƒã®æ¯å¹³å‡å€¤ $o{g} = do{ $o{g} //= 8 ; int $o{g} } ; # 生æˆã™ã‚‹ä¹±æ•°ã®å€‹æ•° 整数切りæ¨ã¦ã¨ã™ã‚‹ã€‚ $o{s} = defined $o{s} ? srand $o{s} : srand ; # random seed ã®è¨å®šã¨å–å¾— my $explambda = exp -($o{m}) ; # 計算上必è¦ã¨ãªã‚‹æ¯å¹³å‡å€¤ã®ã€è‡ªç„¶ã¹ã乗。 my $c = 0 ; # 乱数ã®ç”Ÿæˆæ¸ˆã¿ã®å€‹æ•° die "$0 does not work \nif the number more than 600 is specified for the population average.\n" if $o{m} > 600 ; & main ; & info ; exit 0 ; sub main ( ) { $SIG{INT} = sub { & info ; exit 130 } ; my $until = $o{g} ; while ( $c ++ < $until ) { print & genPoisson , "\n" ; } $c -- ; # 調整ã®ãŸã‚ } sub genPoisson ( ) { my $x = -1 ; my $b = 1.0 ; while ( $b >= $explambda ) { $b *= 1 - rand () ; # 区間(0,1]ã®ä¹±æ•°ã‚’生æˆã™ã‚‹ãŸã‚ã€ã‚ãˆã¦1ã‹ã‚‰æ¸›ç®—ã—ãŸã€‚ $x += 1 ; } return $x ; } sub info ( ) { return if $o{1} ; use FindBin qw [ $Script ] ; my $info = '' ; $info .= color('cyan') . "printed lines: " . color('bright_cyan') . $c ; $info .= color('cyan') . " ; used random seed: " . color('bright_cyan') . $o{s} ; $info .= color('cyan') . " ($Script) " . color('reset') ; print STDERR $info , "\n" ; } ## ヘルプã¨ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ± BEGIN { $Getopt::Std::STANDARD_HELP_VERSION = 1 ; grep { m/--help/} @ARGV and *VERSION_MESSAGE = sub {} ; our $VERSION = 0.13 ; # 最åˆã¯ 0.21 を目安ã¨ã™ã‚‹ã€‚ # 1.00 以上ã¨ã™ã‚‹å¿…è¦æ¡ä»¶ã¯è‹±èªžç‰ˆã®ãƒ˜ãƒ«ãƒ—ã‚’ãã¡ã‚“ã¨å‡ºã™ã“ã¨ã€‚ # 2.00 以上ã¨ã™ã‚‹å¿…è¦æ¡ä»¶ã¯ãƒ†ã‚¹ãƒˆã‚³ãƒ¼ãƒ‰ãŒå«ã‚€ã“ã¨ã€‚ } sub HELP_MESSAGE { use FindBin qw[ $Script $Bin ] ; sub EnvJ ( ) { $ENV{LANG} =~ m/^ja_JP/ ? 1 : 0 } ; # # ja_JP.UTF-8 sub en( ) { grep ( /^en(g(i(sh?)?)?)?/i , @ARGV ) ? 1 : 0 } # English ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰2æ–‡å—以上をå«ã‚€ã‹ sub ja( ) { grep ( /^jp$|^ja(p(a(n?)?)?)?/i , @ARGV ) ? 1 : 0 } # jp ã¾ãŸã¯ japan ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰2æ–‡å—以上をå«ã‚€ã‹ sub opt( ) { grep (/^opt(i(o(ns?)?)?)?$/i, @ARGV ) ? 1 : 0 } # options ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰3æ–‡å—以上å«ã‚€ã‹ã‚‰ sub noPOD ( ) { grep (/^no-?p(od?)?\b/i, @ARGV) ? 1 : 0 } # POD を使ã‚ãªã„ã¨è¨€ã†æŒ‡å®šãŒã•れã¦ã„ã‚‹ã‹ã©ã†ã‹ my $jd = "JapaneseManual" ; my $flagE = ! ja && ( en || ! EnvJ ) ; # 英語ã«ã™ã‚‹ã‹ã©ã†ã‹ã®ãƒ•ラグ exec "perldoc $0" if $flagE && ! opt ; #&& ! noPOD ; $ARGV[1] //= '' ; open my $FH , '<' , $0 ; while(<$FH>){ s/\Q'=script='\E/$Script/gi ; s/\Q'=bin='\E/$Bin/gi ; if ( s/^=head1\b\s*// .. s/^=cut\b\s*// ) { if ( s/^=begin\s+$jd\b\s*// .. s/^=end\s+$jd\b\s*// xor $flagE ) { print $_ if ! opt || m/^\s+\-/ ; } } } close $FH ; exit 0 ; } =encoding utf8 =head1 NAME horsekicks =head1 VERSION 0.13 (2018-07-03) =head1 SYNOPSIS horsekicks [B<-m> mean] [B<-g> how_many] [B<-s> seed] [B<-1>] horsekicks [B<--help> [ja] ] [B<--version>] =head1 DESCRIPTION Generates Poisson random numbers (random variables obeying a Poisson distribution). =head1 OPTION =over 4 =item B<-g> N How many random numbers you want in an integer number. "Inf" can be specified. Default value: 8. =item B<-m> N The population mean (average). Default value: 1.0 =item B<-s> N Random seed. The residual divided by 2*32 is essential. =item B<-1> No secondary information such as random seed on STDERR. =item B<--help> Help message similar appeared here. =item B<--help ja> Japanese manual of this program is shown. =item B<--version> The version information of this program is displayed. =back =head1 REMARKS The calculation time costs proportional to the specified population mean. And the population mean should be less than 700 because the internal calculation by this program causes exp(-750) = 0 . =head1 AUTHOR Toshiyuki Shimono bin4tsv@gmail.com =head1 HISTORY This program has been made since 2016-07-14 (Wed) as a part of TSV hacking toolset for table data. =begin JapaneseManual $0 -g 個数 -m å¹³å‡å€¤ ãƒã‚¢ã‚½ãƒ³ä¹±æ•°ã®ç”Ÿæˆ オプション: -g num : 乱数を発生ã•ã›ã‚‹å€‹æ•°ã€‚åŸºæœ¬çš„ã«æ•´æ•°ã‚’指定。Infも指定å¯èƒ½ã€‚ -m num : æ¯å¹³å‡å€¤ã€‚未指定ãªã‚‰ 1.0 。 -s num : 乱数シードã®è¨å®š (基本的ã«10æ¡ä»¥å†…ã®æ•°) -1 : 乱数シードãªã©ã®æƒ…å ±ã‚’å‡ºåŠ›ã—ãªã„。 --help : ã“ã® $0 ã®ãƒ˜ãƒ«ãƒ—メッセージを出ã™ã€‚ perldoc -t $0 | cat ã§ã‚‚ã»ã¼åŒã˜ã€‚ --help opt : オプションã®ã¿ã®ãƒ˜ãƒ«ãƒ—を出ã™ã€‚opt以外ã§ã‚‚ options ã¨å…ˆé ãŒ1æ–‡å—以上一致ã™ã‚Œã°è‰¯ã„。 --version ã“ã®ãƒ—ãƒã‚°ãƒ©ãƒ ã®ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ±ã‚’å‡ºåŠ›ã€‚ 注æ„: ã“ã®ãƒã‚¢ã‚½ãƒ³ä¹±æ•°ç”Ÿæˆå™¨ã¯ã€è¨ˆç®—æ™‚é–“ãŒæ¯å¹³å‡å€¤ã«ã»ã¼æ¯”例ã™ã‚‹ã€‚ ã¾ãŸã€å†…部ã®è¨ˆç®—ã«ãŠã‘ã‚‹æµ®å‹•å°æ•°ç‚¹ãŒexp(-750)ã®å€¤ã¯ã‚¼ãƒã¨ãªã‚‹ã®ã§ã€ 指定ã™ã‚‹æ¯å¹³å‡ã¯600ã‚’è¶…ãˆã‚‹ã¨æœ›ã¾ã—ããªã„。 * 計算方法ã«ã¯é«˜é€ŸåŒ–ã®ãŸã‚ã€æ”¹è‰¯ã®ä½™åœ°ãŒã‚る。2分木を使ã£ãŸãƒ—ãƒã‚°ãƒ©ãƒ を採用ã™ã‚‹ã“ã¨ã‚’考ãˆã¦ã„る。 * æ¯å¹³å‡ãŒ700ã‚’è¶…ãˆã‚‹å ´åˆã‚’é©åˆ‡ã«å‡¦ç†ã™ã‚‹ã‚ˆã†ã«ã—ãŸã„。 =cut