Board logo

标题: [原创代码] [Perl]在线获取股票数据,构建本地数据库、数据可视化 [打印本页]

作者: 523066680    时间: 2023-3-2 22:03     标题: [Perl]在线获取股票数据,构建本地数据库、数据可视化

本帖最后由 523066680 于 2024-1-13 10:08 编辑

之前在知乎搜索相关接口的时候查到一个 pysnowball,进去页面一看其实也是抓取雪球网站的数据
只需要从调试模式获取一次 token 可以长期使用,不需要密码登录
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. use File::Path qw/make_path/;
  6. use POSIX;
  7. use Mojo::UserAgent;
  8. use JSON qw/from_json to_json/;
  9. STDOUT->autoflush(1);
  10. #my $wdir = "D:/Local/雪球数据/沪深一览";
  11. my $wdir = "D:/Local/雪球数据/ETF一览";
  12. make_path( gbk($wdir) ) unless -d gbk($wdir);
  13. # 沪深 https://stock.xueqiu.com/v5/stock/screener/quote/list.json
  14. # ETF https://stock.xueqiu.com/v5/stock/screener/fund/list.json
  15. my $url = "https://stock.xueqiu.com/v5/stock/screener/fund/list.json";
  16. my %args = (
  17.         'page' => '1',
  18.         'size' => '90',
  19.         'order' => 'desc',
  20.         'order_by' => 'percent',
  21.         'type' => '18',
  22.         'parent_type' => 1
  23.     );
  24. my $ua = Mojo::UserAgent->new();
  25. $ua->cookie_jar->add(
  26.     Mojo::Cookie::Response->new(
  27.         name   => "xq_a_token",
  28.         value  => "这里填入对应的token值,从浏览器cookies记录获取",
  29.         domain => 'stock.xueqiu.com',
  30.         path   => '/',
  31.     )
  32. );
  33. # 获取第一页
  34. my $res = $ua->get( $url, form => \%args )->result;
  35. #printf "%s\n", gbk( to_json( $res->json, {pretty => 1} ));
  36. if ( exists $res->json->{data}{count} )
  37. {
  38.     write_file(  gbk( sprintf "${wdir}/%03d.json", 1 ), $res->body );
  39. }
  40. my $count = $res->json->{data}{count};
  41. my $last = ceil($count / 90);
  42. printf "count %d\n", $count;
  43. for my $pg ( 2 .. $last )
  44. {
  45.     my $export = gbk( sprintf "${wdir}/%03d.json", $pg );
  46.     if ( -f $export )
  47.     {
  48.         printf "Page: %d, exists\n", $pg;
  49.         next;
  50.     }
  51.     # 如果之前不存在,请求数据
  52.     $args{'page'} = $pg;
  53.     my $res = $ua->get( $url, form => \%args )->result;
  54.     if ( exists $res->json->{data}{count} )
  55.     {
  56.         printf "Page: %d\n", $pg;
  57.         write_file( $export, $res->body );
  58.     }
  59.     else
  60.     {
  61.         printf "Page: %d, false\n", $pg;
  62.     }
  63. }
  64. sub gbk { encode('gbk', $_[0]) }
  65. sub utf8 { encode('utf8', $_[0]) }
  66. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  67. sub uni { decode('utf8', $_[0]) }
复制代码

作者: 523066680    时间: 2023-3-2 22:06

紧接着是从众多 JSON中提取关键字和股票代号
好像从沪深改成 ETF,无所谓了,大概意思
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. use File::Path qw/make_path/;
  6. use Mojo::UserAgent;
  7. use JSON qw/from_json to_json/;
  8. STDOUT->autoflush(1);
  9. my $wdir = "D:/Local/雪球数据/ETF一览";
  10. my $count = 0;
  11. my $export = "ETF.txt";
  12. my $buff = "";
  13. for my $f ( glob gbk("$wdir/*.json") )
  14. {
  15.     my $json_str = uni(scalar( read_file( $f )));
  16.     my $data = from_json( $json_str );
  17.     for my $e ( @{$data->{data}{list}} )
  18.     {
  19.         next if $e->{name} =~ /^(ST|\*ST)/i;
  20.         $count ++;
  21.         printf "%s %s\n", $e->{symbol}, gbk($e->{name});
  22.    
  23.         $buff .= sprintf "%s %s\n", $e->{symbol}, $e->{name};
  24.     }
  25. }
  26. write_file( $export, utf8($buff) );
  27. printf "%d\n", $count;
  28. sub gbk { encode('gbk', $_[0]) }
  29. sub utf8 { encode('utf8', $_[0]) }
  30. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  31. sub uni { decode('utf8', $_[0]) }
复制代码
部分结果如下:
SH513260 恒生科技ETFQD
SH513380 恒生科技ETF指数
SH517500 游戏沪港深ETF
SZ159605 中概互联ETF
SZ159742 恒生科技指数ETF
SZ159792 港股通互联网ETF
SZ159688 恒生互联网ETF
SH513770 港股互联网ETF
SH513890 恒生科技HKETF
SZ159607 中概互联网ETF
SH513180 恒生科技指数ETF
SH513130 恒生科技ETF
SH513580 恒生科技ETF基金
SH513010 恒生科技30ETF
SZ159750 香港科技50ETF
SH513330 恒生互联网ETF
SZ159869 游戏ETF

作者: 523066680    时间: 2023-3-2 22:11

再接着就是从上面的清单中,抓取这些标的的历史日K数据
请注意这个日K数据是设置某一个当前日期,然后倒推的。 设置天数为负数,比如-180天
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. use File::Path qw/make_path/;
  6. use Mojo::UserAgent;
  7. use Date::Format;  # time2str
  8. use Date::Parse;   # str2time
  9. use JSON qw/from_json to_json/;
  10. STDOUT->autoflush(1);
  11. my $wdir = "D:/Local/雪球数据/股票数据-日K-20230302-180DAY";
  12. make_path( gbk($wdir) ) unless -d gbk($wdir);
  13. # 提取某个日期之前的日K数据
  14. my %args = (
  15.         'symbol' => '',
  16.         'begin' => time() * 1000 + 3600*24,
  17.         'period' => 'day',
  18.         'type' => 'before',
  19.         'count' => '-185',  # 倒推天数
  20.         'indicator' => 'kline,pe,pb,ps,pcf,market_capital,agt,ggt,balance',
  21.     );
  22. my $ua = Mojo::UserAgent->new();
  23. $ua->cookie_jar->add(
  24.     Mojo::Cookie::Response->new(
  25.         name   => "xq_a_token",
  26.         value  => "这里改成自己的token",
  27.         domain => 'stock.xueqiu.com',
  28.         path   => '/',
  29.     )
  30. );
  31. my @list = read_file("StockList.txt"); # "ETF.txt"
  32. my $n = 0;
  33. for my $e ( @list )
  34. {
  35.     $n++;
  36.     $e =~ s/\r?\n//;
  37.     my ( $code, $name ) = split(/\s+/, uni($e) );
  38.     my $export = gbk("${wdir}/${code}.json");
  39.     # 忽略科创板和创业板
  40.     next if $code =~ /[A-Z]+(688|300)/;
  41.     if ( -f $export )
  42.     {
  43.         printf "[%d/%d] %s %s already exists\n", $n, scalar(@list), $code, gbk( $name );
  44.         next;
  45.     }
  46.    
  47.     printf "[%d/%d] %s %s\n", $n, scalar(@list), $code, gbk( $name );
  48.     $args{'symbol'} = $code;
  49.     my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
  50.     my $data = $res->json;
  51.     if ( $data->{'error_code'} == 0 )
  52.     {
  53.         $data->{'data'}{'name'} = $name;
  54.         write_file( $export, utf8( to_json( $data) ) );
  55.     }
  56. }
  57. sub gbk { encode('gbk', $_[0]) }
  58. sub utf8 { encode('utf8', $_[0]) }
  59. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  60. sub uni { decode('utf8', $_[0]) }
复制代码

作者: 523066680    时间: 2023-3-2 22:17

关于筹码分布、筹码集中度的统计估值,应该会很有意思,有空再弄。
作者: 老刘1号    时间: 2023-3-2 22:50

本帖最后由 老刘1号 于 2023-3-2 22:55 编辑

仰望量化玩家
之前在聚宽写过一个北向资金市值排序跟踪策略,回测还不错,不过没挂实盘
http://www.bathome.net/thread-65352-1-1.html
作者: 523066680    时间: 2023-12-31 18:12

本帖最后由 523066680 于 2024-1-1 18:26 编辑

筹码分布,他来了


调整一下,德芙

作者: 523066680    时间: 2024-1-2 16:51     标题: 构建本地日K数据库 RE: [Perl]获取雪球网站的沪深股票清单 以及 日K数据

本帖最后由 523066680 于 2024-1-2 17:31 编辑

把一些之前做的补发上来

第一步,创建空的 Sqlite 数据表
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. # use Mojo::UserAgent;
  6. use JSON qw/from_json to_json/;
  7. STDOUT->autoflush(1);
  8. use Modern::Perl;
  9. use DBI;
  10. binmode(STDOUT, ":encoding(gbk)");
  11. =note
  12. 分开建表:
  13. * 日K - K线数据、均线数据、两融数据 (主力流入流出数据?待定)
  14. * 周K - K线数据、均线数据
  15. * 月K - K线数据、均线数据
  16. * 股票信息汇总 - 代码、名称、市值、所属概念
  17. =cut
  18. my $database = 'stock_data_init.sqlite';
  19. unlink $database if (-f $database and decode('gbk', __FILE__) =~ /创建/ );  # 无论如何 重新创建
  20. my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
  21. # 创建股票数据表格 stock_data(如果不存在)
  22. $dbh->do( utf8( <<'DAY' ) );
  23. CREATE TABLE IF NOT EXISTS 日K ( -- 暂时去掉 IF NOT EXISTS
  24.     id INTEGER PRIMARY KEY AUTOINCREMENT,
  25.     symbol TEXT NOT NULL,
  26.     date TEXT NOT NULL,
  27.     open REAL,
  28.     high REAL,
  29.     low REAL,
  30.     close REAL,
  31.     volume INTEGER, --成交量
  32.     ma5 REAL,
  33.     ma10 REAL,
  34.     ma20 REAL,
  35.     ma30 REAL,
  36.     ma60 REAL,
  37.     ma120 REAL,
  38.     ma250 REAL,
  39.     换手率 REAL,
  40.     涨跌幅 REAL,
  41.     振幅 REAL,
  42.     融券余额 REAL, --如果这里使用Unicode形式,会被自动转为UTF8
  43.     融券余量 REAL,
  44.     融券净卖出 REAL,
  45.     融券卖出量 REAL,
  46.     融券偿还量 REAL
  47. );
  48. DAY
  49. $dbh->do( utf8( <<'WEEK' ) );
  50. CREATE TABLE IF NOT EXISTS 周K (
  51.     id INTEGER PRIMARY KEY AUTOINCREMENT,
  52.     symbol TEXT NOT NULL,
  53.     date TEXT NOT NULL,
  54.     open REAL,
  55.     high REAL,
  56.     low REAL,
  57.     close REAL,
  58.     volume INTEGER, --成交量
  59.     ma5 REAL,
  60.     ma10 REAL,
  61.     ma20 REAL,
  62.     ma30 REAL,
  63.     ma60 REAL,
  64.     涨跌幅 REAL,
  65.     换手率 REAL
  66. );
  67. WEEK
  68. $dbh->do( utf8( <<'MONTH' ) );
  69. CREATE TABLE IF NOT EXISTS 月K (
  70.     id INTEGER PRIMARY KEY AUTOINCREMENT,
  71.     symbol TEXT NOT NULL,
  72.     date TEXT NOT NULL,
  73.     open REAL,
  74.     high REAL,
  75.     low REAL,
  76.     close REAL,
  77.     volume INTEGER, --成交量
  78.     ma5 REAL,
  79.     ma10 REAL,
  80.     ma20 REAL,
  81.     ma30 REAL,
  82.     涨跌幅 REAL,
  83.     换手率 REAL
  84. );
  85. MONTH
  86. # 创建索引(主要是股票代码和日期),用于提速
  87. # 注意 同一个数据库中,不同的表,索引的名称不能冲突
  88. for my $ktype ( qw/日K 周K 月K/ )
  89. {
  90.     printf "%s\n", $ktype;
  91.     $dbh->do( utf8("CREATE INDEX index_${ktype}_symbol ON ${ktype} ( symbol )") );
  92.     $dbh->do( utf8("CREATE INDEX index_${ktype}_date ON ${ktype} ( date )") );
  93.     $dbh->do( utf8("CREATE UNIQUE INDEX index_${ktype}_symbol_date ON ${ktype} ( symbol, date )") );
  94. }
  95. # 调用插入函数插入数据(纯属虚构)
  96. insert_stock_data( "TEST", "2023-09-06", "11.2", "13.5", "20020" );
  97. # 调用查询函数查询数据 - 测试
  98. query_stock_data( "TEST" );
  99. # 插入股票数据
  100. sub insert_stock_data
  101. {
  102.     # 使用prepare方法准备插入SQL语句。然后,我们使用execute方法执行插入操作,并传递相应的参数。
  103.     my $insert = $dbh->prepare(utf8("INSERT INTO 日K (symbol, date, open, close, volume) VALUES (?, ?, ?, ?, ?)"));
  104.     for ( 1 .. 1 )
  105.     {
  106.         $insert->execute( @_ );        
  107.     }
  108. }
  109. # 查询股票数据
  110. sub query_stock_data
  111. {
  112.     my ($symbol) = @_;
  113.     my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ?") );
  114.     $query->execute($symbol);
  115.     while (my $row = $query->fetchrow_hashref())
  116.     {
  117.         print  uni(dump_json( $row ));
  118.     }
  119. }
  120. sub dump_json
  121. {
  122.     my ($data) = @_;
  123.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  124. }
  125. sub gbk { encode('gbk', $_[0]) }
  126. sub utf8 { encode('utf8', $_[0]) }
  127. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  128. sub uni { decode('utf8', $_[0]) }
复制代码
第二步,下载2022至今的所有日K数据 (歪枣网)
-
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. use Mojo::UserAgent;
  6. use File::Path qw/make_path/;
  7. use Date::Format;  # time2str
  8. use Date::Parse;   # str2time
  9. use JSON qw/from_json to_json/;
  10. STDOUT->autoflush(1);
  11. binmode(STDOUT, ":encoding(gbk)");
  12. my $TOKEN = "歪枣网token";
  13. my $ua = Mojo::UserAgent->new();
  14. my $index = from_json( uni(scalar(read_file( "index.json" ))) );
  15. my $code_map = $index->{'index_by_code'};
  16. my @codes = sort keys %$code_map;
  17. my $total = scalar( @codes );
  18. my $end_date = get_last_date();
  19. my $begin_date = "2022-01-01";
  20. my $LASTDAY = $end_date;
  21. $LASTDAY =~ s/-//g;
  22. my $wdir = "D:/Local/歪枣网/股票数据-日K-2022-${LASTDAY}";
  23. make_path( gbk($wdir) ) unless -d gbk($wdir);
  24. printf "total: %s\n", $total;
  25. printf "end_date: %s\n", $end_date;
  26. # 筛选 ST *ST 科创板(688) 创业板(30x) 以外的票
  27. # 北交所 82、83、87、88
  28. my $it = 0;
  29. my $count = 0;
  30. for my $code ( @codes )
  31. {
  32.     my $name = $code_map->{ $code };
  33.     $name =~ s/\s//g;
  34.     $it++;
  35.     # if ( $code !~ /^(688|30|82|83|87|88)/ and $name !~ /ST/i )
  36.     #if ( $code =~ /^(688|30|82|83|87|88)/ or $name =~ /ST/i )
  37.     # {
  38.         $count ++;
  39.         my $output = gbk("${wdir}/${code}.txt");
  40.         printf "%s %s [%d/%d]\n", $code, $name, $it, $total;
  41.         if ( not -f $output )
  42.         {
  43.             get_data_dayKline( $code, $begin_date, $end_date, $output );            
  44.         }
  45.     # }
  46. }
  47. printf "total: %d\n", $count;
  48. sub get_data_dayKline
  49. {
  50.     my ($code, $start_date, $end_date, $output) = @_;
  51.     # export 数据类型
  52.     # 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  53.     my %args = (
  54.             'fq' => 1,       # 复权信息,取值范围:0|不复权;1|前复权;2|后复权
  55.             'type' => 1,
  56.             'ktype' => 101,  # 101|日线;102|周线;103|月线
  57.             'code' => $code,
  58.             'startDate' => $start_date,
  59.             'endDate' => $end_date,
  60.             'fields' => 'tdate,open,high,low,close,cjl,hsl', # 成交量,换手率
  61.             'export' => "0",
  62.             'token' => $TOKEN,
  63.         );
  64.     my $res = $ua->get( "http://api.waizaowang.com/doc/getDayKLine", form => \%args )->result;
  65.     #print u2gbk($res->body);
  66.     write_file( $output, utf8( $args{'fields'} ."\n" ) );
  67.     append_file( $output, $res->body() );
  68. }
  69. sub get_last_date
  70. {
  71.     my $hour = time2str( "%H", time() );
  72.     my $end_date;
  73.     # 如果大于15:00,日期调整为明天。
  74.     if ( $hour ge "15" ) { $end_date = time2str("%Y-%m-%d", time() + 3600*24);  }
  75.     else                 { $end_date = time2str("%Y-%m-%d", time());  }
  76. }
  77. sub gbk { encode('gbk', $_[0]) }
  78. sub utf8 { encode('utf8', $_[0]) }
  79. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  80. sub uni { decode('utf8', $_[0]) }
复制代码
第三步,遍历本地文件,数据整合到数据库
-
  1. =info
  2.     填充股票的历史日K数据。
  3. =cut
  4. use utf8;
  5. use Encode;
  6. use Modern::Perl;
  7. use File::Slurp;
  8. use File::Basename;
  9. use File::Copy;
  10. use List::MoreUtils qw/zip/;
  11. use JSON qw/from_json to_json/;
  12. STDOUT->autoflush(1);
  13. use Modern::Perl;
  14. use DBI;
  15. binmode(STDOUT, ":encoding(gbk)");
  16. =note
  17. 分开建表:
  18. * 日K - K线数据、均线数据、两融数据 (主力流入流出数据?待定)
  19. * 周K - K线数据、均线数据
  20. * 月K - K线数据、均线数据
  21. * 股票信息汇总 - 代码、名称、市值、所属概念
  22. =cut
  23. # {
  24.     # 测试用
  25.     # unlink "stock_data.sqlite";
  26.     # copy "stock_data_init.sqlite", "stock_data.sqlite";
  27. # }
  28. my $database = 'stock_data.sqlite';
  29. my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
  30. my $src_dir = "D:/Local/歪枣网/股票数据-日K-2022-20231009";
  31. my @files = glob gbk("${src_dir}/*.txt");
  32. my $total = scalar( @files );
  33. my $db_symbols = get_symbols_of_table( $dbh, utf8("日K") );
  34. # begin_work 用于提速,这样不会频繁提交数据
  35. # turning AutoCommit off
  36. # Enable transactions until the next call to commit or rollback
  37. $dbh->begin_work;
  38. my $n = 0;
  39. for my $f ( @files )
  40. {   
  41.     my ($symbol) = ($f =~ /(\d+)\.txt/);
  42.     if ( exists $db_symbols->{$symbol} )
  43.     {
  44.         printf "%s - data already exists in the db\n", decode('gbk', $f);
  45.         next;
  46.     }
  47.     printf "%s [%d/%d]\n", decode('gbk', $f), ++$n, $total;
  48.     load_daily_kline_to_db( $dbh, $f );
  49.     # last;
  50. }
  51. $dbh->commit;
  52. sub load_daily_kline_to_db
  53. {
  54.     my ($dbh, $file) = @_;
  55.     my ($symbol) = ($file =~ /(\d+)\.txt/);
  56.     my @lines = read_file( $file );
  57.     my @keys = split( /,/, $lines[0] );
  58.     # tdate,open,high,low,close,cjl,hsl
  59.     my $insert = $dbh->prepare(
  60.         utf8("INSERT INTO 日K (symbol, date, open, high, low, close, volume, 换手率) VALUES (?, ?, ?, ?, ?, ?, ?, ?)")
  61.     );
  62.     my $total = scalar( @lines ) - 1;
  63.     my $part_size = int($total / 100); # 用于估算处理进度
  64.     # 注意,歪枣网获取的CompanyInfo数据,有可能存在准备上市但未上市的公司记录(603075.txt)。
  65.     # 对应的文件行数为1,只有标题行。
  66.     for my $id ( 1 .. $#lines )
  67.     {
  68.         $lines[$id] =~ s/;\r?\n//;
  69.         my @values = split( /,/, $lines[$id] );
  70.         # my %data = zip @keys, @values;
  71.         $insert->execute( $symbol, @values );
  72.     }
  73.     $insert->finish;
  74.    
  75.     say "";
  76. }
  77. # 获取数据库中已有的日期列表
  78. sub get_symbols_of_table
  79. {
  80.     my ($dbh, $tb_name) = @_;
  81.     my %hash;
  82.     # 得到的 tb_name 自带双引号
  83.     # This utility method combines "prepare", "execute", and fetching one column from all the rows
  84.     my $list = $dbh->selectcol_arrayref( qq(SELECT DISTINCT symbol FROM $tb_name) );
  85.     grep { $hash{$_} = 1 } @$list;
  86.     return \%hash;
  87. }
  88. # 查询股票数据
  89. sub query_stock_data
  90. {
  91.     my ($symbol) = @_;
  92.     my $query = $dbh->prepare("SELECT * FROM 日K WHERE symbol = ?");
  93.     $query->execute($symbol);
  94.     while (my $row = $query->fetchrow_hashref())
  95.     {
  96.         print uni(dump_json( $row ));
  97.     }
  98. }
  99. sub dump_json
  100. {
  101.     my ($data) = @_;
  102.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  103. }
  104. sub gbk { encode('gbk', $_[0]) }
  105. sub utf8 { encode('utf8', $_[0]) }
  106. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  107. sub uni { decode('utf8', $_[0]) }
复制代码

作者: 523066680    时间: 2024-1-3 19:57     标题: 本地数据库 - 日K数据的更新和补充 RE: [Perl]获取雪球网站的沪深股票清单

本帖最后由 523066680 于 2024-1-3 20:07 编辑

本地数据库 - 日K数据的更新和补充 - 从雪球网站获取 - 多线程
数据的更新和补充,本来是从歪枣网获取的,结果歪枣网是晚上才更新,于是改成雪球,盘中就可以更新。
临时更新就有一个问题,就是盘中的数据和收盘后的数据不同,这个处理方案是每次剔除近N天的数据,获取后覆盖。

另外雪球的沪深清单好像不完整,所以就和 歪枣网结合使用了。
  1. =info
  2.     日K数据更新   
  3.     更新方案 - 提取数据库中已有的日期列表,清理末尾N天的数据,重新在线获取并覆盖
  4.     获取数据时使用的股票列表:在线获取名单
  5. =cut
  6. use utf8;
  7. use Encode;
  8. use Modern::Perl;
  9. use File::Slurp;
  10. use File::Basename;
  11. use File::Copy;
  12. use Date::Format;  # time2str
  13. use Date::Parse;   # str2time
  14. use POSIX qw/ceil/;
  15. use List::Util qw/sum max min/;
  16. use List::MoreUtils qw/zip/;
  17. use Mojo::UserAgent;
  18. use JSON qw/from_json to_json/;
  19. use threads;
  20. use threads::shared;
  21. STDOUT->autoflush(1);
  22. use DBI;
  23. use Try::Tiny;
  24. binmode(STDOUT, ":encoding(gbk)");
  25. our $wdir = "day";
  26. mkdir $wdir unless -d $wdir;
  27. system("del ${wdir}\\*.json");
  28. my $ua = Mojo::UserAgent->new();
  29. our $TOKEN = "歪枣网 TOKEN";
  30. our $xq_a_token = "雪球 xq_a_token";
  31. our @mission :shared;
  32. my $database = 'stock_data.sqlite';
  33. my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
  34. my $tb_name = "日K";
  35. my @symbols = get_symbol_list_with_prefix( $ua );
  36. my $dates_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT date FROM [${tb_name}]" );
  37. if ( scalar( @symbols ) < 1000 )
  38. {
  39.     printf "检查歪枣网接口,返回的股票列表为空\n";
  40.     exit;
  41. }
  42. # 选择前N个交易日作为节点
  43. my $date_select = $dates_in_db->[-3];
  44. $dbh->begin_work;
  45. # 清理前两天的数据(然后填入在线获取的数据 - 更新数据)
  46. my $statement = qq(DELETE FROM [${tb_name}] WHERE date >= "${date_select}");
  47. printf "%s\n", $statement;
  48. # 删除该日以及之后的数据
  49. $dbh->do( $statement );
  50. my $begin_time = $date_select;
  51. my $end_time = "2025-12-30";
  52. @mission = @symbols;
  53. # @mission = ();
  54. my @ths;
  55. #创建线程
  56. grep { push @ths, threads->create( \&work, $_, $begin_time ) } ( 1 .. 4 );
  57. #等待运行结束
  58. while ( threads->list(threads::running) ) { sleep 0.2 };
  59. #线程分离/结束
  60. grep { $_->detach() if $_->is_running() } threads->list(threads::all);
  61. # 批量写入数据库
  62. for my $f ( glob "${wdir}/*.json" )
  63. {
  64.     xq_kline_data_to_db( $dbh, $tb_name, $f );
  65. }
  66. say "更新均线数据";
  67. update_MA( $dbh, $tb_name );
  68. $dbh->commit;
  69. sub work
  70. {
  71.     my ( $tid, $begin_time ) = @_;
  72.     my $begin_time_stamp = str2time( $begin_time ) * 1000;
  73.     my $ua_xq = Mojo::UserAgent->new();
  74.     $ua_xq->cookie_jar->add(
  75.         Mojo::Cookie::Response->new(
  76.             name   => "xq_a_token",
  77.             value  => $xq_a_token,
  78.             domain => 'stock.xueqiu.com',
  79.             path   => '/',
  80.         )
  81.     );
  82.     while ( 1 )
  83.     {
  84.         my $target; # my $target 声明放在while内部,确保能够捕捉undef的情况
  85.         {
  86.             lock( @mission );
  87.             $target = shift @mission;
  88.         }
  89.         last unless defined $target;
  90.         my $data = get_xq_kline_data( $ua_xq, $target, $begin_time_stamp );
  91.         if ( defined $data )
  92.         {
  93.             write_file("${wdir}/${target}.json", to_json($data->{'data'}) );
  94.         }
  95.         # if ( defined $data )
  96.         # {
  97.         #     for my $e ( @{$data->{'data'}{'item'}} )
  98.         #     {
  99.         #         # 0              1        2       3       4      5
  100.         #         # "timestamp", "volume", "open", "high", "low", "close",
  101.         #         $e->[0] = time2str("%Y-%m-%d %H:%M:%S", $e->[0]/1000);
  102.         #         $insert->execute( $target, @{$e}[0,2,3,4,5,1] );
  103.         #     }
  104.         # }
  105.         #完成后任务信息输出
  106.         printf "[%d] target: %s\n", threads->tid(), $target;
  107.     }
  108.     # get_xq_kline_data();
  109. }
  110. sub get_xq_kline_data
  111. {
  112.     my ( $ua, $symbol, $begin_time ) = @_;
  113.     my %args = (
  114.             'symbol' => $symbol,
  115.             'begin' => $begin_time,
  116.             'period' => 'day',
  117.             'type' => 'before',  # 前复权
  118.             'count' => '1000',     # 向前(时间节点递增)提取
  119.             'indicator' => 'kline,ma',
  120.         );
  121.     my $retry = 0;
  122.     while ( $retry < 5 )
  123.     {
  124.         my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
  125.         my $data = $res->json;
  126.         if ( exists $data->{'data'}{'item'} )
  127.         {
  128.             return $data;
  129.             # printf "%d\n", scalar @{$data->{'data'}{'item'}};
  130.             last;
  131.         }
  132.         else
  133.         {
  134.             printf "%s Retry: %d\n", $symbol, $retry;
  135.             last if ( $retry++ >= 5 );
  136.         }
  137.     }
  138.     return undef;
  139. }
  140. sub xq_kline_data_to_db
  141. {
  142.     my ($dbh, $tb_name, $file) = @_;
  143.     my ( $code ) = ($file =~ /[A-Z]+(\d{6})/);
  144.     my @items = qw/
  145.         symbol date volume open high low close ma5 ma10 ma20 ma30 涨跌幅 换手率
  146.     /;
  147.     my $items_insert = join(",", @items);
  148.     my $placeholds = join(", ", map {"?"} @items );
  149.     # 使用prepare方法准备插入SQL语句。然后,我们使用execute方法执行插入操作,并传递相应的参数。
  150.     my $insert = $dbh->prepare(
  151.         utf8("INSERT INTO [${tb_name}] (${items_insert}) VALUES (${placeholds})")
  152.     );
  153.     my $data = from_json( uni(scalar(read_file( $file ))) );
  154.     # 雪球返回数据的列标
  155.     my @keys = @{$data->{'column'}};
  156.     for my $e ( @{$data->{'item'}} )
  157.     {
  158.         my %kv = zip @keys, @{$e};
  159.         $kv{'time'} = time2str("%Y-%m-%d", $kv{'timestamp'} /1000);
  160.         # 雪球返回的成交量是股为单位,歪枣网的数据是"手" 为单位
  161.         $kv{'volume'} = int($kv{'volume'}/100.0);
  162.         # 振幅 - 振幅的参考基数是昨天的收盘价  (最高-最低)/(昨收)*100.0
  163.         # 所以振幅留到后续再补充
  164.         $insert->execute( $code, @{kv}{qw/time volume open high low close ma5 ma10 ma20 ma30 percent turnoverrate /} );
  165.     }
  166.     $insert->finish;
  167. }
  168. sub update_MA
  169. {
  170.     my ( $dbh, $tb_name ) = @_;
  171.    
  172.     my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM [${tb_name}]" );
  173.     my $curr = 0;
  174.     my $total = scalar @$codes;
  175.     for my $code ( @$codes )
  176.     {
  177.         $curr++;
  178.         printf "[%d/%d] %s\n", $curr, $total, $code;
  179.         # 先获取单个标的的所有 id 映射表,在写入数据时通过id索引定位节点,达到提速效果
  180.         # ORDER BY date ASC => 按日期排序 - 升序
  181.         my $query = $dbh->prepare( utf8("SELECT * FROM [${tb_name}] WHERE symbol = ? ORDER BY date ASC") );
  182.         $query->execute( $code );
  183.         my $rows = $query->fetchall_arrayref( {} );
  184.         my $total = scalar @$rows;
  185.         for my $days ( 60, 120, 250 )
  186.         {
  187.             next if $total < $days;
  188.             my $days_float = $days * 1.0;
  189.             my $sth = $dbh->prepare( utf8("UPDATE [${tb_name}] SET ma${days} = ? WHERE id = ?") );
  190.             for my $idx ( $days-1 .. $#$rows )
  191.             {
  192.                 next if defined $rows->[$idx]{"ma$days"}; # 如果已有均线数据,跳过
  193.                 # printf "%d - %d\n", $days, $idx;
  194.                 my $sum = sum( map { $_->{'close'} } @{$rows}[ $idx-$days+1 .. $idx ] ); # 6 7 8 9 10 when idx = 10, ma = 5
  195.                 my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$idx]{'id'} );
  196.                 die if ( $result == -1 or $result eq "0E0" );
  197.             }
  198.         }
  199.         # print decode('utf8', dump_json($rows));
  200.         # print $rows->[1][0];
  201.     }
  202. }
  203. # 获取带 SZ SH BJ 前缀的股票代码清单
  204. sub get_symbol_list_with_prefix
  205. {
  206.     my ( $ua ) = @_;
  207.     my %args = (
  208.             'code' => "All",  # 全部
  209.             'fields' => 'code,stype', # 股票代码, 股票类型,1:深证股票,2:上证股票,3:北证股票,4:港股
  210.             'token' => $TOKEN,
  211.             'export' => "1",
  212.             # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  213.         );
  214.     my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;
  215.     my @list;
  216.     my $TYPE = { 1 => "SZ", 2 => "SH", 3 => "BJ", 4 => "HK" };
  217.     for my $e ( @{$res->json->{'data'}} )
  218.     {
  219.         my $code = $TYPE->{ $e->{'stype'} } . $e->{'code'};
  220.         push @list, $code;
  221.     }
  222.     return @list;
  223. }
  224. sub get_symbol_list
  225. {
  226.     my ( $ua ) = @_;
  227.     my %args = (
  228.             'code' => "All",  # 全部
  229.             'fields' => 'code,name', # 股票代码
  230.             'token' => $TOKEN,
  231.             'export' => "1",
  232.             # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  233.         );
  234.     my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;
  235.     my @list = map { $_->{'code'} } @{$res->json->{'data'}};
  236.     return @list;
  237. }
  238. sub abort
  239. {
  240.     my ( $dbh ) = @_;
  241.    
  242.     $dbh->rollback;
  243.     exit;
  244. }
  245. sub dump_json
  246. {
  247.     my ($data) = @_;
  248.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  249. }
  250. sub gbk { encode('gbk', $_[0]) }
  251. sub utf8 { encode('utf8', $_[0]) }
  252. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  253. sub uni { decode('utf8', $_[0]) }
复制代码

作者: 523066680    时间: 2024-1-4 16:29     标题: 统计+补充本地日K均线数据 RE: [Perl]构建本地日K数据库

均线数据虽然说有些网站也提供,但是像雪球只提供MA5 10 20 30 60,其他的没有了,写一套罢~
--
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use File::Slurp;
  5. use List::Util qw/sum/;
  6. use Math::Round qw/nearest_floor nlowmult/;
  7. # use Mojo::UserAgent;
  8. use JSON qw/from_json to_json/;
  9. STDOUT->autoflush(1);
  10. use Modern::Perl;
  11. use DBI;
  12. binmode(STDOUT, ":encoding(gbk)");
  13. my $database = 'stock_data.sqlite';
  14. my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
  15. $dbh->begin_work;
  16. # 从日K数据表中获取股票名单
  17. # DISTINCT 关键字用于去重
  18. my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );
  19. my $curr = 0;
  20. my $total = scalar @$codes;
  21. for my $code ( @$codes )
  22. {
  23.     $curr++;
  24.     printf "[%d/%d] %s\n", $curr, $total, $code;
  25.     # 先获取单个标的的所有 id 映射表,在写入数据时通过id索引定位节点,达到提速效果
  26.     # ORDER BY date ASC => 按日期排序 - 升序
  27.     my $query = $dbh->prepare( utf8("SELECT id,symbol,date,close FROM 日K WHERE symbol = ? ORDER BY date ASC") );
  28.     $query->execute( $code );
  29.     my $rows = $query->fetchall_arrayref( {} );
  30.     my $total = scalar @$rows;
  31.     for my $days ( 5, 10, 20, 30, 60, 120, 250 )
  32.     {
  33.         next if $total < $days;
  34.         my $days_float = $days * 1.0;
  35.         my $sth = $dbh->prepare( utf8("UPDATE 日K SET ma${days} = ? WHERE id = ?") );
  36.         # 更新N日均线的第一个节点数值
  37.         my $sum = sum( map { $_->{'close'} } @{$rows}[ 0 .. $days-1 ] );
  38.         $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$days-1]{'id'} );
  39.         for my $iter ( $days .. $#$rows )
  40.         {
  41.             $sum += $rows->[$iter]{'close'} - $rows->[$iter-$days]{'close'};
  42.             my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$iter]{'id'} );
  43.             die if ( $result == -1 or $result eq "0E0" );
  44.             # printf "%s ma%d %.3f\n", $rows->[$iter]{'date'}, $days, $sum/5.0;
  45.         }
  46.     }
  47.     # print decode('utf8', dump_json($rows));
  48.     # print $rows->[1][0];
  49. }
  50. $dbh->commit;
  51. $dbh->disconnect;
  52. sub query_stock_data
  53. {
  54.     my ($symbol, $date) = @_;
  55.     my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ? AND date = ?") );
  56.     my $result = $query->execute($symbol, $date) or die;
  57.     printf $result;
  58.     # while (my $row = $query->fetchrow_hashref())
  59.     # {
  60.     #     print  uni(dump_json( $row ));
  61.     # }
  62. }
  63. sub dump_json
  64. {
  65.     my ($data) = @_;
  66.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  67. }
  68. sub gbk { encode('gbk', $_[0]) }
  69. sub utf8 { encode('utf8', $_[0]) }
  70. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  71. sub uni { decode('utf8', $_[0]) }
复制代码

作者: 523066680    时间: 2024-1-5 21:41     标题: 获取股票基本信息以及映射表 RE: [Perl]构建本地股票数据库

本帖最后由 523066680 于 2024-1-5 21:55 编辑

获取股票基本信息,包括概念、主营业务,这部分信息量不大,JSON比较合适。

1. baseinfo_all.json
  1. =info
  2.     除息日的票显示为XD开头,使用 getCompanyInfo 重新获取股票名
  3.     ST *ST 等开头,getCompanyInfo 获取的结果仍是ST。
  4.     歪枣网 股票曾用名 接口 - getStockReName,似乎无法获取有效结果,返回
  5.     {"code":200,"message":"成功","data":[]}
  6. =cut
  7. use utf8;
  8. use Encode;
  9. use Modern::Perl;
  10. use File::Slurp;
  11. use Mojo::UserAgent;
  12. use JSON qw/from_json to_json/;
  13. STDOUT->autoflush(1);
  14. my $token = '歪枣网TOKEN';
  15. =info
  16.     getCompany 的信息相对更详细,但是需要订阅接口权限
  17.     getBaseInfo 包含基本的股票概念(板块)、流通市值、上市日期 等信息
  18. =cut
  19. my %args = (
  20.         #'code' => "601949",
  21.         'code' => "all",
  22.         'type' => 1, # 1|沪深京A股;2|沪深京B股;3|港股;4|美股;5|黄金;6|汇率;7|Reits;10|沪深指数;11|香港指数;12|全球指数;13|债券指数;20|场内基金;30|沪深债券;40|行业板块;41|概念板块;42|地域板块
  23.         'fields' => 'code,name,stype,bk,ssdate,z50,z52,z53',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
  24.         'token' => $token,
  25.         'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  26.     );
  27. my $ua = Mojo::UserAgent->new();
  28. # print u2gbk( $res->body );
  29. my $res = $ua->get( "http://api.waizaowang.com/doc/getBaseInfo", form => \%args )->result;
  30. # 还有一些板块信息,在 另一个接口中提供
  31. # getCompanyInfo?code=600187&fields=code,name,mainbusin
  32. my $data = $res->json;
  33. my @codes = map { $_->{'code'} } @{$data->{'data'}};
  34. my $total = scalar @{$data->{'data'}};
  35. my $count = 0;
  36. my %busin_map;
  37. while ( scalar(@codes) > 0 )
  38. {
  39.     my @parts = splice @codes, 0, 50;
  40.     my $main_business = 获取主营业务( $ua, join(",", @parts) );
  41.     for my $e ( @$main_business )
  42.     {
  43.         $busin_map{ $e->{'code'} } = $e->{'mainbusin'};
  44.     }
  45.     # printf "%s\n", gbk( dump_json ($main_business));
  46.     # last;
  47.     printf "%d/%d\n", $count, $total;
  48.     $count+=50;
  49. }
  50. for my $e ( @{$data->{'data'}} )
  51. {
  52.     my $code = $e->{'code'};
  53.     my $main_business = $busin_map{$code};
  54.     $main_business = "" if not defined $main_business;
  55.     my $concept = $e->{'z53'} .";". $main_business;
  56.     $e->{'concept'} = $concept;
  57. }
  58. # print u2gbk($res->body);
  59. write_file( "baseInfo_all.json", utf8(dump_json( $data )) );
  60. # stype 值对照 - 1:深证股票,2:上证股票,3:北证股票,4:港股
  61. # 返回 JSON 数据时有效性判断
  62. # if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
  63. # {
  64. #     print gbk(dump_json($res->json->{'data'}[0]));
  65. # }
  66. # else
  67. # {
  68. #     print gbk(dump_json($res->body));
  69. # }
  70. sub 获取主营业务
  71. {
  72.     my ( $ua, $codes_str ) = @_;
  73.     my %args = (
  74.         'code' => $codes_str,
  75.         'fields' => 'code,mainbusin',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
  76.         'token' => $token,
  77.         'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  78.     );
  79.     my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo", form => \%args )->result;
  80.     return $res->json->{'data'};
  81. }
  82. sub dump_json
  83. {
  84.     my ($data) = @_;
  85.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  86. }
  87. sub gbk { encode('gbk', $_[0]) }
  88. sub utf8 { encode('utf8', $_[0]) }
  89. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  90. sub uni { decode('utf8', $_[0]) }
  91. __DATA__
  92. # R:融资融券标的,也就是说这只股票是融资融券的标的股;
  93. # K:科创板股票,科创板资金门槛50万;涨跌幅20%;
  94. # S:还没进行完股改,涨跌幅5%;
  95. # ST:连续两年亏损或被处理的股票,涨跌幅5%;
  96. # *ST:连续三年亏损,有退市风险,投资者应谨慎参与;
  97. # N:当日上市股票,出现带有N字母的股票,其首日涨跌幅不受限制;
  98. # NST:经过重组或者股改重新上市的ST股;
  99. # PT:已经退市股票;
复制代码
2. concept.json
  1. =info
  2.     除息日的票显示为XD开头,使用 getCompanyInfo 重新获取股票名
  3.     ST *ST 等开头,getCompanyInfo 获取的结果仍是ST。
  4.     歪枣网 股票曾用名 接口 - getStockReName,似乎无法获取有效结果,返回
  5.     {"code":200,"message":"成功","data":[]}
  6. =cut
  7. use utf8;
  8. use Encode;
  9. use Modern::Perl;
  10. use File::Slurp;
  11. use Mojo::UserAgent;
  12. use JSON qw/from_json to_json/;
  13. STDOUT->autoflush(1);
  14. binmode( STDOUT, ":encoding(gbk)");
  15. my $token = '歪枣网TOKEN';
  16. my $baseinfo = from_json( uni(scalar(read_file( "baseinfo_all.json" ))) );
  17. my $concept = {};
  18. printf "total: %d\n", scalar @{$baseinfo->{'data'}};
  19. my $except = qr/(昨日连板_含一字|昨日涨停_含一字|HS300_|深圳特区|AB股|AH股|QFII重仓|预盈预增|预亏预减|机构重仓|沪股通|深成500|中证\d+|上证\d+|深证100R|央视50_|融资融券|证金持股|深股通|MSCI中国|富时罗素|标准普尔|破净股)/;
  20. for my $e ( @{$baseinfo->{'data'}} )
  21. {
  22.     my $cpt = join(",", ($e->{'z52'},$e->{'z53'},$e->{'z50'}) );
  23.     $cpt =~ s/${except},?//g;
  24.     my @cps = grep { $_ !~ /^[_-]$/ } split( /[,;]/, $cpt );
  25.     # printf "%s %s\n", $e->{'code'}, $cpt;
  26.     $concept->{$e->{'code'}} = [ @cps ];
  27. }
  28. write_file( "concept.json", utf8(dump_json( $concept )) );
  29. sub dump_json
  30. {
  31.     my ($data) = @_;
  32.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  33. }
  34. sub gbk { encode('gbk', $_[0]) }
  35. sub utf8 { encode('utf8', $_[0]) }
  36. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  37. sub uni { decode('utf8', $_[0]) }
复制代码
3. index.json 主要是 名称 <=> 代码的 相互映射
  1. =info
  2.     除息日的票显示为XD开头,使用 getCompanyInfo 重新获取股票名
  3.     ST *ST 等开头,getCompanyInfo 获取的结果仍是ST。
  4.     歪枣网 股票曾用名 接口 - getStockReName,似乎无法获取有效结果,返回
  5.     {"code":200,"message":"成功","data":[]}
  6. =cut
  7. use utf8;
  8. use Encode;
  9. use Modern::Perl;
  10. use File::Slurp;
  11. use Mojo::UserAgent;
  12. use JSON qw/from_json to_json/;
  13. STDOUT->autoflush(1);
  14. my $token = '歪枣网TOKEN';
  15. my %args = (
  16.         'code' => "All",  # 全部
  17.         'fields' => 'code,name,z50,z53', # 股票代码、股票名称、归属行业板块名称、归属概念板块名称
  18.         'token' => $token,
  19.         'export' => "1",
  20.         # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
  21.     );
  22. my $ua = Mojo::UserAgent->new();
  23. my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;
  24. # print u2gbk( $res->body );
  25. my %hash;
  26. my @list = @{$res->json->{'data'}};
  27. for my $e ( @list )
  28. {
  29.     # 除权、除息股票,获取原名
  30.     # DR:除权除息;表示当日是该只股票的除权除息日;
  31.     # XD:除息日,这只股票的除息日;
  32.     # XR:除权日,这只股票的除权日。
  33.     if ( $e->{'name'} =~ /^(XD|XR|RD)/i )
  34.     {
  35.         my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo",
  36.                             form => {
  37.                                 code => $e->{'code'},
  38.                                 fields => 'name',
  39.                                 export => '1',
  40.                                 token => $token
  41.                             }
  42.                         )->result;
  43.         if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
  44.         {
  45.             # printf "%s => %s\n", gbk($e->{'name'}), gbk( $res->json->{'data'}[0]{'name'} );
  46.             $e->{'name'} = $res->json->{'data'}[0]{'name'};
  47.         }
  48.     }
  49.     $e->{'name'} =~ s/\s//g;
  50.     $hash{'index_by_code'}{ $e->{'code'} } = $e->{'name'};
  51.     $hash{'index_by_name'}{ $e->{'name'} } = $e->{'code'};
  52. }
  53. # 数量
  54. printf "total: %d\n", scalar( keys %{$hash{'index_by_code'}} );
  55. write_file( gbk("index.json"), utf8(to_json(\%hash, {pretty => 1, canonical => 1 } )) );
  56. sub gbk { encode('gbk', $_[0]) }
  57. sub utf8 { encode('utf8', $_[0]) }
  58. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  59. sub uni { decode('utf8', $_[0]) }
复制代码
index.json 形式如下
  1. {
  2.    "index_by_code" : {
  3.       "000001" : "平安银行",
  4.       "000002" : "万科A"
  5.    },
  6.    "index_by_name" : {
  7.       "平安银行" : "000001",
  8.       "万科A" : "000002"
  9.    }
  10. }
复制代码

作者: xczxczxcz    时间: 2024-1-5 22:11

若不是'专家'或操盘手,那所有所谓的各种指数都是泘云,'画'出来的K线就是用割韭菜的。
本人一直无视各种指标图,玩股票就三条路:有内幕资料,会易经,命中财旺正行财运。其它都是韭菜。本人用易经虽还没研究出从众多票中选出最有前途的股,但对选定的股测其走势升降从未有虚。比如某股正在下跌中就可以测是否到底,或反弹后是否开始降。至今未失手。(本人不嗜赌,偶尔玩玩)。再比如不买双色球,10-13个号基本可测出7个号码,但不能买,理由大家都懂,剪刀石头布,先出永远是输,此类测之无益。
命中财薄,玩出花也难发。看过那么多八字,无一例外。
作者: 523066680    时间: 2024-1-5 22:15

本帖最后由 523066680 于 2024-1-5 22:46 编辑

回复 11# xczxczxcz


    我做娱乐用,在Perl区没有人,刷存货代码呢(一天发一段挤牙膏)。这个项目带点实质性数据展示,龙虎榜可视化之类
我24年接下来的项目,完完全全纯娱乐(没卵用就对了),炫就完事,基本也不适合发这边。
作者: 523066680    时间: 2024-1-6 20:30     标题: 使用Image::Magick绘制自定义K线图 RE: [Perl]构建本地股票数据库

本帖最后由 523066680 于 2024-1-6 20:48 编辑

基本的“数据要素”已经准备差不多,该画画了,请出的第一个接口是 Image::Magick ,

数据文件清单
  1. index.json - 股票名称 代码映射表
  2. baseInfo_all.json - 基本信息表
  3. concept.json - 概念映射表
  4. stock_data.sqlite - 日K、均线历史数据
复制代码
以下是Perl模块:DrawKlineMA.pm 代码
  1. package DrawKlineMA;
  2. use utf8;
  3. use Encode;
  4. use Modern::Perl;
  5. use File::Slurp;
  6. use List::Util qw/sum max min/;
  7. use List::MoreUtils qw/zip/;
  8. use Date::Format;  # time2str
  9. use Date::Parse;   # str2time
  10. use JSON qw/from_json to_json/;
  11. use Image::Magick;
  12. sub Draw
  13. {
  14.     my ( $code, $name, $data, $concept, $export ) = @_;
  15.     if ( -f gbk($export) )
  16.     {
  17.         # printf "png file already exists\n";
  18.         # return;
  19.     }
  20.    
  21.     if ( $#$data < 80 )
  22.     {
  23.         printf "the data quantity less than 80\n";
  24.     }
  25.     else
  26.     {
  27.         @$data = @{$data}[-80 .. -1];
  28.     }
  29.     # 创建一个新的图片对象
  30.     my $image = Image::Magick->new(size => '1200x500');
  31.     $image->Read('xc:white');
  32.     my $layer1 = Image::Magick->new(size => '1200x500');
  33.     $layer1->Read('xc:none');
  34.      
  35.     my ( $W, $H ) = ( $image->Get("width"), $image->Get("height") );
  36.     # 设置绘图参数
  37.     my $bar_width = 10;  # K线的宽度
  38.     my $padding = 3;   # K线之间的间距
  39.     my $max_value = max( map { $_->{'high'} } @$data );
  40.     my $min_value = min( map { $_->{'low'} } @$data );
  41.     my $bar_delta = $max_value - $min_value;
  42.     my $max_volume = max( map { $_->{'volume'} } @$data );
  43.     my $VOL_BASE = $H * 0.2;
  44.     my $VOL_MAX_H = $H * 0.1;
  45.     my $BAR_BASE = $VOL_BASE + $VOL_MAX_H + 10;
  46.     my $BAR_MAX_H = $H * 0.5;
  47.     # 两融数据 - 考虑数据中有NULL的情况
  48.     my @margin_data = grep { defined $_ } map { $_->{utf8('融券余额')} } @$data;
  49.     my $margin_max = max( @margin_data );
  50.     my $margin_min = min( @margin_data );
  51.     my $margin_delta = scalar(@margin_data) > 0 ? $margin_max - $margin_min : undef;
  52.     my $margin_sum = sum( @margin_data );
  53.     # 绘制外框
  54.     # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $VOL_BASE, $VOL_BASE+$VOL_MAX_H, "none", "gray" );
  55.     # 绘制外框
  56.     # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $BAR_BASE, $BAR_BASE+$BAR_MAX_H, "none", "gray" );
  57.     my @words = split /,/, $concept;
  58.     my $buff = "";
  59.     while ( @words )
  60.     {
  61.         $buff .= join(", ", splice(@words, 0, 10)) ."\n";
  62.     }
  63.     # 板块信息
  64.     $image->Annotate(
  65.         text      => $buff,
  66.         x         => int($W*1/4),
  67.         y         => 20,
  68.         fill      => 'black',
  69.         font      => "Simhei",
  70.         pointsize => 16,
  71.         align     => 'left',
  72.         gravity => "SouthWest",
  73.         'word-break' => 'break-word',
  74.     );
  75.     # 股票名称
  76.     $image->Annotate(
  77.         text      => sprintf("%s(%s)", $name, $code),
  78.         x         => 10,
  79.         y         => 28,
  80.         fill      => 'black',
  81.         font      => "Simhei",
  82.         pointsize => 28,
  83.         align     => 'left',
  84.         gravity => "SouthWest",
  85.     );
  86.     # 绘制K线图
  87.     my $x = $padding;
  88.    
  89.     # 均线起点值
  90.     my $prev = {};
  91.     my @ma_list = qw/ma5 ma10 ma20 ma30 ma60 ma120 ma250/;
  92.     my @colors = qw/black orange pink green blue purple brown cyan/;
  93.     my $mcolor = {};
  94.     my $cid = 0;
  95.     # 初始化均线起点值,但也要考虑某些标的,长周期分均线一开始并未出现的情况
  96.     for my $ma ( @ma_list )
  97.     {
  98.         $mcolor->{$ma} = $colors[$cid++];
  99.         $prev->{$ma} = $data->[0]->{$ma};
  100.     }
  101.     $prev->{'margin'} = $data->[0]->{'融券余额'};
  102.     my $prev_close = 0.0;
  103.     for my $kline ( @$data )
  104.     {
  105.         my $date = $kline->{date};
  106.         my $open = $kline->{open};
  107.         my $high = $kline->{high};
  108.         my $low = $kline->{low};
  109.         my $close = $kline->{close};
  110.         my $volume = $kline->{volume};
  111.         # 计算K线的高度
  112.         my $delta = abs($open - $close);
  113.         my $bar_open = ($open - $min_value )/ $bar_delta * $BAR_MAX_H;
  114.         my $bar_close = ($close - $min_value )/ $bar_delta * $BAR_MAX_H;
  115.         # 上下影线位置
  116.         my $bar_high = ($high - $min_value )/ $bar_delta * $BAR_MAX_H;
  117.         my $bar_low = ($low - $min_value )/ $bar_delta * $BAR_MAX_H;
  118.         # 颜色 - 下跌时为绿色实心,上涨或者不涨为白色实心、红色边界
  119.         my $fill = $close > $open ? "white" : "green";
  120.         my $stroke = $close > $open ? "red" : "green";
  121.         # 如果是一字上涨
  122.         if ( $close == $open and $close > $prev_close )
  123.         { $fill = "white"; $stroke = "red"; }
  124.         # 绘制上下影线
  125.         draw_line_range( $image, $x+$bar_width/2, $BAR_BASE+$bar_high, $BAR_BASE+$bar_low, $stroke );
  126.         # printf "%.2f %.2f %d %d\n", $high, $low, $bar_high, $bar_low;
  127.         # 绘制K柱
  128.         draw_rect_range( $image, $x, $x+$bar_width, $BAR_BASE+$bar_open, $BAR_BASE+$bar_close, $fill, $stroke );
  129.         # 绘制量能条
  130.         my $volume_height = $volume / $max_volume * $VOL_MAX_H;
  131.         draw_rect_range( $image, $x, $x+$bar_width, $VOL_BASE, $VOL_BASE+$volume_height, $fill, $stroke );
  132.         # 绘制融券数据
  133.         if ( defined $kline->{utf8('融券余额')} and $margin_sum != 0 )
  134.         {
  135.             my $k = utf8("融券余额");
  136.             if ( not defined $prev->{$k}  )
  137.             {
  138.                 $prev->{$k} = $kline->{$k};
  139.             }
  140.             else
  141.             {
  142.                 # printf "%.2f\n", $kline->{$k};
  143.                 # pt1 是上一个点的位置 pt2是当前点的位置
  144.                 my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H };
  145.                 my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H };
  146.                 draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, "CYAN" );
  147.                 $prev->{$k} = $kline->{$k};
  148.             }
  149.         }
  150.         # 绘制均线
  151.         for my $ma ( @ma_list )
  152.         {
  153.             # 考虑某些标的,长周期分均线一开始并未出现的情况;先记录数据,留到下一节点绘制
  154.             if ( not defined $prev->{$ma} )
  155.             {
  156.                 $prev->{$ma} = $kline->{$ma};
  157.                 next;
  158.             }
  159.             # pt1 是上一个点的位置 pt2是当前点的位置
  160.             my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H };
  161.             my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H };
  162.             draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, $mcolor->{$ma} );
  163.             $prev->{$ma} = $kline->{$ma};
  164.         }
  165.         # 日期字符串长度
  166.         my @mertics = $image->QueryFontMetrics(text => $date, font => 'Arial', pointsize => 12 );
  167.         my $text_width = $mertics[4];
  168.         # 绘制日期
  169.         my $text_x = $x;
  170.         my $text_y = $VOL_BASE;
  171.         $image->Annotate(
  172.             text      => $date,
  173.             x         => $text_x + $padding/2,
  174.             y         => $H - $VOL_BASE + $text_width/2 + $padding,
  175.             rotate    => 90,
  176.             fill      => 'black',
  177.             # stroke    => 'black',
  178.             font      => 'Arial',
  179.             pointsize => 12,
  180.             align     => 'Center',
  181.             gravity => "South",
  182.         );
  183.         # 更新X轴位置
  184.         $x += $bar_width + $padding;
  185.         $prev_close = $close;
  186.     }
  187.     $layer1->Evaluate( channel => "Alpha", operator => "Multiply", value => 0.6 );
  188.     $image->Composite( image => $layer1 );
  189.     $image->Set( "Alpha" => "On");
  190.     # 保存图像
  191.     $image->Write( $export );
  192. }
  193. # 符合直觉的坐标绘制(y在底部)
  194. sub draw_line
  195. {
  196.     my ( $cv, $x1, $y1, $x2, $y2, $color, $strokewidth ) = @_;
  197.     my ( $h ) = $cv->Get("Height");
  198.     $cv->Draw(
  199.         primitive => 'line',
  200.         points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
  201.         stroke    => $color,
  202.         strokewidth => 1.0
  203.     );
  204. }
  205. # 符合直觉的坐标绘制(y在底部)
  206. sub draw_line_range
  207. {
  208.     my ( $cv, $x, $y1, $y2, $color ) = @_;
  209.     my ( $h ) = $cv->Get("Height");
  210.     $cv->Draw(
  211.         primitive => 'line',
  212.         points    =>  sprintf("%d,%d %d,%d", $x, $h-$y1, $x, $h-$y2 ),
  213.         stroke    => $color
  214.     );
  215. }
  216. # 符合直觉的坐标绘制(y在底部)
  217. sub draw_rect_range
  218. {
  219.     my ( $cv, $x1, $x2, $y1, $y2, $fill, $stroke ) = @_;
  220.     my ( $h ) = $cv->Get("Height");
  221.     $cv->Draw(
  222.         primitive => 'rectangle',
  223.         points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
  224.         fill      => $fill,
  225.         stroke    => $stroke,
  226.     );
  227. }
  228. sub dump_json
  229. {
  230.     my ($data) = @_;
  231.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  232. }
  233. sub gbk { encode('gbk', $_[0]) }
  234. sub utf8 { encode('utf8', $_[0]) }
  235. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  236. sub uni { decode('utf8', $_[0]) }
  237. 1;
复制代码
现在,可以做一些特征筛选、板块组合筛选,并且批量生成走势图的操作。
按板块筛选并且批量绘图的脚本:
  1. use utf8;
  2. use Encode;
  3. use Modern::Perl;
  4. use DBI;
  5. use File::Slurp;
  6. use File::Path qw/make_path/;
  7. use File::Basename;
  8. use Mojo::UserAgent;
  9. use Date::Format;  # time2str
  10. use Date::Parse;   # str2time
  11. use List::Util qw/max min sum/;
  12. use JSON qw/from_json to_json/;
  13. STDOUT->autoflush(1);
  14. use FindBin;
  15. use lib $FindBin::Bin;
  16. use DrawKlineMA;
  17. # 数据库路径不需要转换为GBK
  18. my $db = "stock_data.sqlite";
  19. my $dbh = DBI->connect("dbi:SQLite:dbname=$db") or die "can not connect DB: $DBI::errstr";
  20. my $codes_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );
  21. my $total_in_db = scalar @$codes_in_db;
  22. # 股票代号 - 名称 对照表
  23. my $index = from_json( uni(scalar(read_file( "index.json" ))) );
  24. my $baseinfo_all = from_json( uni(scalar(read_file( "baseInfo_all.json" ))) );
  25. my $concept;
  26. for my $e ( @{$baseinfo_all->{'data'}} )
  27. {
  28.     $concept->{$e->{code}} = $e->{'concept'} .",". $e->{'z52'};
  29. }
  30. my $output_dir = "./先进封装";
  31. mkdir gbk($output_dir) unless -d gbk($output_dir);
  32. for my $code ( @$codes_in_db )
  33. {
  34.     next if $code =~ /TEST/i;
  35.     # next unless $code eq "001268";
  36.     # printf "current: %s\n", $code;
  37.     my $name = exists $index->{'index_by_code'}{$code} ? $index->{'index_by_code'}{$code} : "unknow";
  38.     my $data = load_kline_data( $dbh, $code, 90 );
  39.    
  40.     # 如果少于90天,PASS
  41.     next if scalar( @$data ) < 90;
  42.     # 工业母机 工业4.0
  43.     # 一带一路 and 新疆
  44.     if ( not exists $concept->{ $code } )
  45.     {
  46.         printf "${code}: concept not found\n";
  47.         next;
  48.     }
  49.     next unless $concept->{ $code } =~ /钙钛/;
  50.     next unless $concept->{ $code } =~ /半导体/;
  51.     # next unless $concept->{ $code } =~ /华为/;
  52.     # next unless $concept->{ $code } =~ /ChatGPT/;
  53.     printf "%s %s\n", $code, gbk($name);
  54.     # next;
  55.     my $export = "${output_dir}/${code}-${name}.png";
  56.     DrawKlineMA::Draw( $code, $name, $data, $concept->{$code}, $export );
  57. }
  58. sub load_kline_data
  59. {
  60.     my ( $dbh, $code, $n ) = @_;
  61.     # 查询数据
  62.     my $query = "SELECT * FROM 日K WHERE symbol = ? ORDER BY date DESC LIMIT ?";
  63.     # selectall_arrayref 函数可以返回带列标名称的哈希数据
  64.     # $n 表示要获取的行数
  65.     my $result = $dbh->selectall_arrayref($query, { Slice => {} }, $code, $n);
  66.     # print dump_json( $result );
  67.     @$result = reverse @$result;
  68.     return $result;
  69. }
  70. sub dump_json
  71. {
  72.     my ($data) = @_;
  73.     return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
  74. }
  75. sub gbk { encode('gbk', $_[0]) }
  76. sub utf8 { encode('utf8', $_[0]) }
  77. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  78. sub uni { decode('utf8', $_[0]) }
复制代码
生成的图片样张,其中青蓝色的是融券数据(最近懒得更新了所以止步12月)
-


这样一张图竟然需要3~5秒,无法忍受,于是就重新勾起了远古的回忆 —— 为什么不用OpenGL渲染?下回再说。
作者: 523066680    时间: 2024-1-10 20:31     标题: 生成K线图的性能问题 RE: [Perl]在线获取股票名单、K线数据,构建本地数据库

本帖最后由 523066680 于 2024-1-10 23:29 编辑

Image::Magick 绘制一张60天左右的K线图,耗时3~5秒,有可能是因为大量的日期文字软渲染,这不重要,重要的是有效率碾压的替代方案。
大致的思路:
1. 根据代码和日期范围,加载数据库数据,计算有效天数
2. 使用OpenGL接口创建FBO 帧缓冲对象,根据天数判定并设置"画布"宽度
3. 绘制
4. FBO转纹理导出图片
实测 180天数据,日K+30分钟K+周K+资金流入流出数据,大约3000x2000像素的图片,耗时0.5秒。其中大部分耗时可能来自文本的矢量字形处理,以及频繁的drawcall,没有打包成VBO,还有很大的优化空间。
  1.     //创建 fbo 根据日期范围决定 画布宽度
  2.     int fbo_width = (int)(bar_width + padding) * count_of_days + 100;
  3.     fbo = gl::Fbo::create(fbo_width, canvas_h, fbo_fmt);
  4.     cout << "fbo_width:" << fbo_width << endl;
复制代码
绑定渲染对象为 fbo,并设置视景范围
  1.         fbo->bindFramebuffer();
  2.         gl::viewport(0, 0, w, h);
  3.         mCam.setOrtho( -center.x, center.x, -center.y, center.y, 0.1, 1000.0);
复制代码
绘制

FBO转纹理导出图片
  1. writeImage( fs::path( imgfile ), fbo->getColorTexture()->createSource() );
复制代码
样张:


样张2, 4690x1850

作者: 523066680    时间: 2024-1-12 19:37

本帖最后由 523066680 于 2024-1-13 12:50 编辑

这用了OpenGL画图,空间就打开了,想要做点更丰富的。
由于某种原因我拿到了一些陈旧的level2数据,就是那些逐笔明细,其实很想把量化的虚假挂单撤单过程做成动画呈现,看看量化怎么愚弄散户的,可惜数据里只有实际成交,没有撤单的部分。

做的第一个可视化动画是一天的板块资金流动变化,但是这东西得连起来观察,单日呈现也没啥意义,因为疯狂轮动。


接着是把逐笔明细做可视化,初步排除使用图片呈现,考虑那些大的委托单,他们在上午挂单,并不是一瞬间交易完的,分成了很多小单,如果一直挂着,没有匹配的价位,有可能到下午才完成一笔大单。
并且,一个大买单在委托时,可能挂了更高的价位,一路扫上去,就意味着中间产生价格波动。买卖大单之间,亦可能产生交集。
总的来说形容为“时空数据”应该不为过,那么如何把这些过程通过动画形象地呈现出来?就是非常有趣的问题。

初始的版本,为了充分发挥花里胡哨+无卵用的特质,甚至用了 rtmidi 库,按量和时间产生不同的音乐,然而并不好听,主要是不懂音乐。


大部分时候都没有考虑性能问题,怎么粗暴怎么堆。
然后一个成交量的柱子,除了位置平移表示其成交价格的变化,填充的比例表示实际成交的比例。还考虑加一种填充方式表示10W以内的小单,因为多种颜色实在是太花哨了,后来就改用斜纹。
这里为了速度还是得用一下片段着色器,
做一个小小的数学题,给定一个方形的所有像素点,如何画一条斜线?y==x ,如何画很多条间隔斜线?(x+y) % 2 == 1 ;要控制3个像素为一个间隔 (x+y) % 6 >= 3
  1.         uniform int hint;
  2.         uniform vec4 color1;
  3.         uniform vec4 color2;
  4.         uniform int left;
  5.         out vec4 FragColor;
  6.         void main( void )
  7.         {
  8.             ivec2 coord = ivec2(gl_FragCoord.xy);
  9.             if ( (coord.x-left+coord.y) % 6 > hint ) {
  10.                 FragColor = color1;
  11.             } else {
  12.                 FragColor = color2;
  13.             }
  14.         }
复制代码
改完以后是这样的:

作者: 523066680    时间: 2024-1-12 21:10

本帖最后由 523066680 于 2024-1-12 22:50 编辑

这个动画实现之后,还是可以看到一些有意思的现象,
比如这个是在最高处,柚子利用情绪高潮,拆单出货,甚至价格还在上涨


视频 - 没有佛山系封不住的板(适合手机/竖屏)
https://www.bilibili.com/video/B ... 9619ae4c9ca3e73db47

地天(适合手机/竖屏)
https://www.bilibili.com/video/BV1x94y1T7pw/

完结。
作者: 523066680    时间: 2024-1-17 20:55


向着娱乐性去打造的,上个月在抖音收获 50W播放量,2400粉,速度还在递增,
可能评论区聊的太开触发了什么,被封禁哈哈~
腾讯视频那边也是起量很快,一小时1.2W播放量然后迅速冻结流量,需要提供财经资质。
被迫开启下一个(和Stock无关的)项目。




欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2