funny/gp.pl

   1 #!/bin/env perl
   2 use strict;
   3 use warnings;
   4
   5 my $path='E:\BGI\gaosj\dat\\';
   6
   7 unless (@ARGV){
   8         print "perl $0 <begin date(\"10/22/2009\")> [days for UD (2)]\n";
   9         exit;
  10 }
  11
  12 my $date = shift;
  13 my $dayUD = shift;
  14
  15 my $Days=5;
  16 my $UpRatio=.6;
  17 my $UpRate=.02;
  18 my $BorderRatioU=1/4;   # 1/4
  19 my $BorderRatioD=1/5;   # 1/5
  20
  21 $dayUD=2 unless $dayUD;
  22 $dayUD=2 unless $dayUD == 1;
  23 $date='10/22/2009' unless $date=~/^\d+\/\d+\/\d{4}$/;
  24 print "Caltulating from [$date] to $Days days later with [$dayUD]...\n";
  25 my (%Names,%Max,%Min,%Files,%Values,%P);
  26
  27 opendir INDIR,$path or warn "[!]Error opening [$path]: $!\n";
  28 for my $file (readdir INDIR) {
  29         if ($file =~ /([^.]+)\.txt$/i) { $Files{$1}=$file;}
  30 }
  31 closedir INDIR;
  32
  33 sub Cal($$$) {
  34         my ($inref,$max,$min)=@_;
  35         my ($cur,$p,$ud)=@$inref;
  36         my ($av,$ap,$aud,$bv,$bp,$bud);
  37         if ($cur*(1+$UpRate) > $max) {
  38                 $aud=$bud=-1;
  39                 $ap=$p;
  40                 $bp=0;
  41         } elsif ($cur*(1-$UpRate) < $min) {
  42                 $aud=$bud=1;
  43                 $ap=$p;
  44                 $bp=0;
  45         } else {
  46                 $aud=$ud;
  47                 $bud=-$ud;
  48                 $ap=$p*$UpRatio;
  49                 $bp=$p*(1-$UpRatio);
  50         }
  51
  52         $av=$cur*(1+$aud*$UpRate);
  53         $bv=$cur*(1+$bud*$UpRate) if $bp != 0;
  54         if ($bp == 0) { return [[$av,$ap,$aud]]; }
  55          else {return [[$av,$ap,$aud],[$bv,$bp,$bud]];}
  56         #my @t=([$av,$ap,$aud],[$bv,$bp,$bud]);
  57         #return [[$av,$ap,$aud],[$bv,$bp,$bud]];
  58 }
  59
  60 my $skip=0;
  61 MAIN: for my $id (keys %Files) {
  62         open IN,'<',$path.$Files{$id} or die "[!]Error opening [$path$Files{$id}]: $!\n";
  63         my $line=<IN>;
  64         $line =~ /(\d+) (.+) \S+$/;
  65         my $ID=$1;
  66         $Names{$ID}=$2;
  67 #print "$id\t$1\t",$Names{$ID},"\n";
  68         <IN>;
  69         my ($max0,$min0,$end0,$endpre,$endpt)=(-999999,999999,-1,-1,-1);
  70         while (<IN>) {
  71 #      日期       开盘          最高          最低          收盘          成交量       成交额
  72                 my ($dateitem,$begin,$max,$min,$end)=split /\t/;
  73                 $max0=$max if $max0<$max;
  74                 $min0=$min if $min0>$min;
  75                 if ($date eq $dateitem) {
  76                         $end0=$end;
  77                         $endpre=($dayUD==2)?$endpt:$begin;
  78                 }
  79                 $endpt=$end;
  80         }
  81         close IN;
  82         $Max{$id}=$max0;
  83         $Min{$id}=$min0;
  84 #print "$Max{$id},$Min{$id}\t$end0\n";
  85         if ($end0==-1 or $endpre==-1 or $end0==$endpre) {
  86 #       if ($end0==-1 or $end0==$endpre or ! defined $endpre) {
  87                 #warn "[!]$date not found in $id !\n";
  88                 ++$skip;
  89                 next MAIN;
  90                 #$end0=0;
  91         }
  92 #print "$Max{$id},$Min{$id}\t$end0\t";
  93         #my $Result=&Cal($max0,$min0,$end0);
  94         my $UDbegin=($end0>=$endpre)?1:-1;
  95         my @Days=([[$end0,1,$UDbegin]]);        # ($cur,$p,$ud)
  96         #my @Days=([[$end0,$UpRatio,$UDbegin],[$end0,1-$UpRatio,-$UDbegin]]);
  97         my $max=($max0-$end0)*$BorderRatioU+$end0;
  98         my $min=($min0-$end0)*$BorderRatioU+$end0;
  99         for (my $i=1;$i<=$Days;$i++) {  # 0..4
 100                 $Days[$i]=[];
 101                 push @{$Days[$i]},@{&Cal($_,$max,$min)} for @{$Days[$i-1]};
 102         }
 103         my ($i,$resp)=(0);
 104         for my $day (@Days) {
 105                 ++$i;
 106                 my ($ups,$upp,$downs,$downp)=(0,0,0,0);
 107                 for (@$day) {
 108                         my ($cur,$p,$ud)=@$_;
 109                         #if ($cur >= $end0) {
 110                         if ($ud == 1) {
 111                                 $ups += $cur*$p;
 112                                 $upp += $p;
 113                         } else {
 114                                 $downs += $cur*$p;
 115                                 $downp += $p;
 116                         }
 117                 }
 118                 $resp += $upp;
 119         }
 120         #$Values{$ID}=$resv;
 121         $P{$ID}=$resp/$i;
 122 #print "$resv\t$resp\n";# if $resv > 1;
 123 }
 124
 125 warn "[!]$skip skipped !\n" if $skip;
 126
 127 my @KEYs=sort {$P{$b} <=> $P{$a}} keys %P;
 128
 129 for my $i (0..9) {
 130         my $key=$KEYs[$i];
 131         print "$key\t$Names{$key}:\t$P{$key}\n";
 132 }
 133 print "\n";
 134 for my $i (-5..-1) {
 135         my $key=$KEYs[$i];
 136         print "$key\t$Names{$key}:\t$P{$key}\n";
 137 }
 138
 139 my %t;
 140 for (values %P) {
 141         ++$t{$_};
 142 }
 143 for (sort {$b <=> $a} keys %t) {
 144         print "$_\t$t{$_}\n";
 145 }