fork download
copy 
  1. use strict;
  2. use warnings;
  3. use v5.20;
  4. use Data::Dumper;
  5. use utf8;
  6.  
  7. #binmode STDOUT, ":encoding(cp932)";
  8. #binmode STDERR, ":encoding(cp932)";
  9.  
  10. my $SEATS = 100;
  11.  
  12. sub getKey($) {
  13.     my ($i) = @_;
  14.     return "HUMAN_${i}";
  15. }
  16.  
  17. sub test {
  18.     my @SEAT_SET = sort { rand() < 0.5 } ( 1 .. ${SEATS} );
  19.  
  20.     my %TICKETS = ();
  21.  
  22.     for my $i ( 1 .. $SEATS ) {
  23.         $TICKETS{ getKey($i) } = $SEAT_SET[ $i - 1 ];
  24.     }
  25.  
  26.     my @ENTER_ORDER = sort { rand() < 0.5 } keys %TICKETS;
  27.  
  28.     my %TICKETS_REST = %TICKETS;
  29.  
  30.     my @humanOrder = sort { rand() < 0.5 } ( 1 .. $SEATS );
  31.     my $order      = 0;
  32.  
  33.     my $lastResult;
  34.     for my $i (@humanOrder) {
  35.         $order++;
  36.  
  37.         my $name       = getKey($i);
  38.         my $answerSeat = $TICKETS{$name};
  39.  
  40.         my $choiseSeat;
  41.         if ( $order == 1 ) {
  42.             my $falseName = ( sort { rand() < 0.5 } keys(%TICKETS_REST) )[0];
  43.             $choiseSeat = $TICKETS_REST{$falseName};
  44.             delete $TICKETS_REST{$falseName};
  45.             if ( $name eq $falseName ) {
  46.                 #warn "[OK] ${name} は自分の席に座りました";
  47.                 $lastResult = 1;
  48.             }
  49.             else {
  50.                 #warn "[NG] ${name} は ${falseName}の席に座りました";
  51.                 $lastResult = 0;
  52.             }
  53.         }
  54.         else {
  55.             if ( exists $TICKETS_REST{$name} ) {
  56.                 $choiseSeat = $TICKETS_REST{$name};
  57.                 delete $TICKETS_REST{$name};
  58.  
  59.                 #warn "[OK] ${name} は自分の席に座りました";
  60.                 $lastResult = 1;
  61.             }
  62.             else {
  63.                 # 席がない
  64.                 my $falseName =
  65.                   ( sort { rand() < 0.5 } keys(%TICKETS_REST) )[0];
  66.                 $choiseSeat = $TICKETS_REST{$falseName};
  67.                 delete $TICKETS_REST{$falseName};
  68.  
  69.                 #warn "[NG] ${name} は ${falseName}の席に座りました";
  70.                 $lastResult = 0;
  71.             }
  72.         }
  73.     }
  74.  
  75.     return $lastResult;
  76. }
  77.  
  78. my $TRIES = 100;
  79. my $count = 0;
  80. for(1..$TRIES) {
  81.     my $result = test();
  82.     $count += $result;
  83. }
  84. say sprintf("%d回試行した結果は%fでした", $TRIES, $count / $TRIES);
Success #stdin #stdout #stderr 0.04s 6884KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
100回試行した結果は0.470000でした
stderr
copy 
Wide character in say at prog.pl line 84.
https://ideone.com/Am9t0p
language:
Perl (perl 5.28.1)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!