[原创代码] [Perl]在线获取股票数据，构建本地数据库、数据可视化

523066680

之前在知乎搜索相关接口的时候查到一个 pysnowball，进去页面一看其实也是抓取雪球网站的数据
只需要从调试模式获取一次 token 可以长期使用，不需要密码登录

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use POSIX;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

#my $wdir = "D:/Local/雪球数据/沪深一览";
my $wdir = "D:/Local/雪球数据/ETF一览";
make_path( gbk($wdir) ) unless -d gbk($wdir);

# 沪深 https://stock.xueqiu.com/v5/stock/screener/quote/list.json
# ETF https://stock.xueqiu.com/v5/stock/screener/fund/list.json

my $url = "https://stock.xueqiu.com/v5/stock/screener/fund/list.json";

my %args = (
        'page' => '1',
        'size' => '90',
        'order' => 'desc',
        'order_by' => 'percent',
        'type' => '18',
        'parent_type' => 1
    );

my $ua = Mojo::UserAgent->new();

$ua->cookie_jar->add( 
    Mojo::Cookie::Response->new(
        name   => "xq_a_token",
        value  => "这里填入对应的token值，从浏览器cookies记录获取",
        domain => 'stock.xueqiu.com',
        path   => '/',
    )
);

# 获取第一页
my $res = $ua->get( $url, form => \%args )->result;
#printf "%s\n", gbk( to_json( $res->json, {pretty => 1} ));

if ( exists $res->json->{data}{count} )
{
    write_file(  gbk( sprintf "${wdir}/%03d.json", 1 ), $res->body );
}

my $count = $res->json->{data}{count};
my $last = ceil($count / 90);

printf "count %d\n", $count;

for my $pg ( 2 .. $last )
{
    my $export = gbk( sprintf "${wdir}/%03d.json", $pg );
    if ( -f $export )
    {
        printf "Page: %d, exists\n", $pg;
        next;
    }

    # 如果之前不存在，请求数据
    $args{'page'} = $pg;
    my $res = $ua->get( $url, form => \%args )->result;
    if ( exists $res->json->{data}{count} )
    {
        printf "Page: %d\n", $pg;
        write_file( $export, $res->body );
    }
    else
    {
        printf "Page: %d, false\n", $pg;
    }
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

523066680

紧接着是从众多 JSON中提取关键字和股票代号
好像从沪深改成 ETF，无所谓了，大概意思

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $wdir = "D:/Local/雪球数据/ETF一览";
my $count = 0;
my $export = "ETF.txt";
my $buff = "";
for my $f ( glob gbk("$wdir/*.json") )
{
    my $json_str = uni(scalar( read_file( $f )));
    my $data = from_json( $json_str );
    for my $e ( @{$data->{data}{list}} )
    {
        next if $e->{name} =~ /^(ST|\*ST)/i;
        $count ++;
        printf "%s %s\n", $e->{symbol}, gbk($e->{name});
    
        $buff .= sprintf "%s %s\n", $e->{symbol}, $e->{name};
    }
}

write_file( $export, utf8($buff) );

printf "%d\n", $count;

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
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

再接着就是从上面的清单中，抓取这些标的的历史日K数据
请注意这个日K数据是设置某一个当前日期，然后倒推的。 设置天数为负数，比如-180天

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use Mojo::UserAgent;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $wdir = "D:/Local/雪球数据/股票数据-日K-20230302-180DAY";
make_path( gbk($wdir) ) unless -d gbk($wdir);

# 提取某个日期之前的日K数据
my %args = (
        'symbol' => '',
        'begin' => time() * 1000 + 3600*24,
        'period' => 'day',
        'type' => 'before',
        'count' => '-185',  # 倒推天数
        'indicator' => 'kline,pe,pb,ps,pcf,market_capital,agt,ggt,balance',
    );

my $ua = Mojo::UserAgent->new();

$ua->cookie_jar->add( 
    Mojo::Cookie::Response->new(
        name   => "xq_a_token",
        value  => "这里改成自己的token",
        domain => 'stock.xueqiu.com',
        path   => '/',
    )
);

my @list = read_file("StockList.txt"); # "ETF.txt"
my $n = 0;
for my $e ( @list )
{
    $n++;
    $e =~ s/\r?\n//;
    my ( $code, $name ) = split(/\s+/, uni($e) );
    my $export = gbk("${wdir}/${code}.json");

    # 忽略科创板和创业板
    next if $code =~ /[A-Z]+(688|300)/;

    if ( -f $export )
    {
        printf "[%d/%d] %s %s already exists\n", $n, scalar(@list), $code, gbk( $name );
        next;
    }
    
    printf "[%d/%d] %s %s\n", $n, scalar(@list), $code, gbk( $name );
    $args{'symbol'} = $code;
    my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
    my $data = $res->json;
    if ( $data->{'error_code'} == 0 )
    {
        $data->{'data'}{'name'} = $name;
        write_file( $export, utf8( to_json( $data) ) );
    }
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

523066680

关于筹码分布、筹码集中度的统计估值，应该会很有意思，有空再弄。

老刘1号

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

523066680

筹码分布，他来了


调整一下，德芙

523066680

把一些之前做的补发上来

第一步，创建空的 Sqlite 数据表

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
# use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

=note
分开建表：
* 日K - K线数据、均线数据、两融数据 （主力流入流出数据？待定）
* 周K - K线数据、均线数据
* 月K - K线数据、均线数据
* 股票信息汇总 - 代码、名称、市值、所属概念
=cut

my $database = 'stock_data_init.sqlite';
unlink $database if (-f $database and decode('gbk', __FILE__) =~ /创建/ );  # 无论如何 重新创建
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

# 创建股票数据表格 stock_data（如果不存在）
$dbh->do( utf8( <<'DAY' ) );
CREATE TABLE IF NOT EXISTS 日K ( -- 暂时去掉 IF NOT EXISTS
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    ma60 REAL,
    ma120 REAL,
    ma250 REAL,
    换手率 REAL,
    涨跌幅 REAL,
    振幅 REAL,
    融券余额 REAL, --如果这里使用Unicode形式，会被自动转为UTF8
    融券余量 REAL,
    融券净卖出 REAL,
    融券卖出量 REAL,
    融券偿还量 REAL
);
DAY

$dbh->do( utf8( <<'WEEK' ) );
CREATE TABLE IF NOT EXISTS 周K (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    ma60 REAL,
    涨跌幅 REAL,
    换手率 REAL
);
WEEK

$dbh->do( utf8( <<'MONTH' ) );
CREATE TABLE IF NOT EXISTS 月K (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    涨跌幅 REAL,
    换手率 REAL
);
MONTH

# 创建索引(主要是股票代码和日期)，用于提速
# 注意 同一个数据库中，不同的表，索引的名称不能冲突
for my $ktype ( qw/日K 周K 月K/ )
{
    printf "%s\n", $ktype;
    $dbh->do( utf8("CREATE INDEX index_${ktype}_symbol ON ${ktype} ( symbol )") );
    $dbh->do( utf8("CREATE INDEX index_${ktype}_date ON ${ktype} ( date )") );
    $dbh->do( utf8("CREATE UNIQUE INDEX index_${ktype}_symbol_date ON ${ktype} ( symbol, date )") );
}

# 调用插入函数插入数据（纯属虚构）
insert_stock_data( "TEST", "2023-09-06", "11.2", "13.5", "20020" );

# 调用查询函数查询数据 - 测试
query_stock_data( "TEST" );

# 插入股票数据
sub insert_stock_data
{
    # 使用prepare方法准备插入SQL语句。然后，我们使用execute方法执行插入操作，并传递相应的参数。
    my $insert = $dbh->prepare(utf8("INSERT INTO 日K (symbol, date, open, close, volume) VALUES (?, ?, ?, ?, ?)"));

    for ( 1 .. 1 )
    {
        $insert->execute( @_ );        
    }
}

# 查询股票数据
sub query_stock_data
{
    my ($symbol) = @_;

    my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ?") );
    $query->execute($symbol);

    while (my $row = $query->fetchrow_hashref())
    {
        print  uni(dump_json( $row ));
    }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

第二步，下载2022至今的所有日K数据 (歪枣网)
-

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use File::Path qw/make_path/;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

my $TOKEN = "歪枣网token";

my $ua = Mojo::UserAgent->new();
my $index = from_json( uni(scalar(read_file( "index.json" ))) );
my $code_map = $index->{'index_by_code'};
my @codes = sort keys %$code_map;
my $total = scalar( @codes );
my $end_date = get_last_date();
my $begin_date = "2022-01-01";

my $LASTDAY = $end_date;
$LASTDAY =~ s/-//g;
my $wdir = "D:/Local/歪枣网/股票数据-日K-2022-${LASTDAY}";
make_path( gbk($wdir) ) unless -d gbk($wdir);

printf "total: %s\n", $total;
printf "end_date: %s\n", $end_date;

# 筛选 ST *ST 科创板(688) 创业板(30x) 以外的票
# 北交所 82、83、87、88

my $it = 0;
my $count = 0;
for my $code ( @codes )
{
    my $name = $code_map->{ $code };
    $name =~ s/\s//g;
    $it++;
    # if ( $code !~ /^(688|30|82|83|87|88)/ and $name !~ /ST/i )
    #if ( $code =~ /^(688|30|82|83|87|88)/ or $name =~ /ST/i )
    # {
        $count ++;
        my $output = gbk("${wdir}/${code}.txt");
        printf "%s %s [%d/%d]\n", $code, $name, $it, $total;
        if ( not -f $output )
        {
            get_data_dayKline( $code, $begin_date, $end_date, $output );            
        }
    # }
}

printf "total: %d\n", $count;

sub get_data_dayKline
{
    my ($code, $start_date, $end_date, $output) = @_;

    # export 数据类型
    # 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    my %args = (
            'fq' => 1,       # 复权信息，取值范围：0|不复权；1|前复权；2|后复权
            'type' => 1,
            'ktype' => 101,  # 101|日线；102|周线；103|月线
            'code' => $code,
            'startDate' => $start_date,
            'endDate' => $end_date,
            'fields' => 'tdate,open,high,low,close,cjl,hsl', # 成交量，换手率
            'export' => "0",
            'token' => $TOKEN,
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getDayKLine", form => \%args )->result;

    #print u2gbk($res->body);
    write_file( $output, utf8( $args{'fields'} ."\n" ) );
    append_file( $output, $res->body() );
}

sub get_last_date
{
    my $hour = time2str( "%H", time() );
    my $end_date;
    # 如果大于15:00，日期调整为明天。
    if ( $hour ge "15" ) { $end_date = time2str("%Y-%m-%d", time() + 3600*24);  }
    else                 { $end_date = time2str("%Y-%m-%d", time());  }
}


sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

第三步，遍历本地文件，数据整合到数据库
-

=info
    填充股票的历史日K数据。
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Basename;
use File::Copy;
use List::MoreUtils qw/zip/;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

=note
分开建表：
* 日K - K线数据、均线数据、两融数据 （主力流入流出数据？待定）
* 周K - K线数据、均线数据
* 月K - K线数据、均线数据
* 股票信息汇总 - 代码、名称、市值、所属概念
=cut

# {
    # 测试用
    # unlink "stock_data.sqlite";
    # copy "stock_data_init.sqlite", "stock_data.sqlite";
# }

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

my $src_dir = "D:/Local/歪枣网/股票数据-日K-2022-20231009";
my @files = glob gbk("${src_dir}/*.txt");
my $total = scalar( @files );

my $db_symbols = get_symbols_of_table( $dbh, utf8("日K") );

# begin_work 用于提速，这样不会频繁提交数据
# turning AutoCommit off
# Enable transactions until the next call to commit or rollback
$dbh->begin_work;

my $n = 0;
for my $f ( @files )
{   
    my ($symbol) = ($f =~ /(\d+)\.txt/);

    if ( exists $db_symbols->{$symbol} )
    {
        printf "%s - data already exists in the db\n", decode('gbk', $f);
        next;
    }

    printf "%s [%d/%d]\n", decode('gbk', $f), ++$n, $total;
    load_daily_kline_to_db( $dbh, $f );
    # last;
}

$dbh->commit;


sub load_daily_kline_to_db
{
    my ($dbh, $file) = @_;

    my ($symbol) = ($file =~ /(\d+)\.txt/);
    my @lines = read_file( $file );
    my @keys = split( /,/, $lines[0] );
    # tdate,open,high,low,close,cjl,hsl

    my $insert = $dbh->prepare(
        utf8("INSERT INTO 日K (symbol, date, open, high, low, close, volume, 换手率) VALUES (?, ?, ?, ?, ?, ?, ?, ?)")
    );

    my $total = scalar( @lines ) - 1;
    my $part_size = int($total / 100); # 用于估算处理进度 

    # 注意，歪枣网获取的CompanyInfo数据，有可能存在准备上市但未上市的公司记录(603075.txt)。
    # 对应的文件行数为1，只有标题行。

    for my $id ( 1 .. $#lines )
    {
        $lines[$id] =~ s/;\r?\n//;
        my @values = split( /,/, $lines[$id] );
        # my %data = zip @keys, @values;
        $insert->execute( $symbol, @values );
    }

    $insert->finish;
    
    say "";
}

# 获取数据库中已有的日期列表
sub get_symbols_of_table
{
    my ($dbh, $tb_name) = @_;
    my %hash;

    # 得到的 tb_name 自带双引号
    # This utility method combines "prepare", "execute", and fetching one column from all the rows
    my $list = $dbh->selectcol_arrayref( qq(SELECT DISTINCT symbol FROM $tb_name) );

    grep { $hash{$_} = 1 } @$list;

    return \%hash;
}


# 查询股票数据
sub query_stock_data
{
    my ($symbol) = @_;

    my $query = $dbh->prepare("SELECT * FROM 日K WHERE symbol = ?");
    $query->execute($symbol);

    while (my $row = $query->fetchrow_hashref())
    {
        print uni(dump_json( $row ));
    }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

523066680

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

另外雪球的沪深清单好像不完整，所以就和 歪枣网结合使用了。

=info
    日K数据更新    
    更新方案 - 提取数据库中已有的日期列表，清理末尾N天的数据，重新在线获取并覆盖
    获取数据时使用的股票列表：在线获取名单
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Basename;
use File::Copy;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use POSIX qw/ceil/;
use List::Util qw/sum max min/;
use List::MoreUtils qw/zip/;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
use threads;
use threads::shared;
STDOUT->autoflush(1);

use DBI;
use Try::Tiny;
binmode(STDOUT, ":encoding(gbk)");

our $wdir = "day";
mkdir $wdir unless -d $wdir;
system("del ${wdir}\\*.json");

my $ua = Mojo::UserAgent->new();
our $TOKEN = "歪枣网 TOKEN";
our $xq_a_token = "雪球 xq_a_token";
our @mission :shared;

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
my $tb_name = "日K";

my @symbols = get_symbol_list_with_prefix( $ua );
my $dates_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT date FROM [${tb_name}]" );

if ( scalar( @symbols ) < 1000 )
{
    printf "检查歪枣网接口，返回的股票列表为空\n";
    exit;
}

# 选择前N个交易日作为节点
my $date_select = $dates_in_db->[-3];

$dbh->begin_work;

# 清理前两天的数据（然后填入在线获取的数据 - 更新数据）
my $statement = qq(DELETE FROM [${tb_name}] WHERE date >= "${date_select}");
printf "%s\n", $statement;

# 删除该日以及之后的数据
$dbh->do( $statement );

my $begin_time = $date_select;
my $end_time = "2025-12-30";

@mission = @symbols;
# @mission = ();

my @ths;
#创建线程
grep { push @ths, threads->create( \&work, $_, $begin_time ) } ( 1 .. 4 );

#等待运行结束
while ( threads->list(threads::running) ) { sleep 0.2 };

#线程分离/结束
grep { $_->detach() if $_->is_running() } threads->list(threads::all);

# 批量写入数据库
for my $f ( glob "${wdir}/*.json" )
{
    xq_kline_data_to_db( $dbh, $tb_name, $f );
}

say "更新均线数据";
update_MA( $dbh, $tb_name );

$dbh->commit;

sub work
{
    my ( $tid, $begin_time ) = @_;

    my $begin_time_stamp = str2time( $begin_time ) * 1000;

    my $ua_xq = Mojo::UserAgent->new();
    $ua_xq->cookie_jar->add( 
        Mojo::Cookie::Response->new(
            name   => "xq_a_token",
            value  => $xq_a_token,
            domain => 'stock.xueqiu.com',
            path   => '/',
        )
    );

    while ( 1 )
    {
        my $target; # my $target 声明放在while内部，确保能够捕捉undef的情况 
        { 
            lock( @mission );
            $target = shift @mission;
        }

        last unless defined $target;

        my $data = get_xq_kline_data( $ua_xq, $target, $begin_time_stamp );
        if ( defined $data )
        {
            write_file("${wdir}/${target}.json", to_json($data->{'data'}) );
        }

        # if ( defined $data )
        # {
        #     for my $e ( @{$data->{'data'}{'item'}} )
        #     {
        #         # 0              1        2       3       4      5
        #         # "timestamp", "volume", "open", "high", "low", "close",
        #         $e->[0] = time2str("%Y-%m-%d %H:%M:%S", $e->[0]/1000);
        #         $insert->execute( $target, @{$e}[0,2,3,4,5,1] );
        #     }
        # }

        #完成后任务信息输出
        printf "[%d] target: %s\n", threads->tid(), $target;
    }

    # get_xq_kline_data();
}

sub get_xq_kline_data
{
    my ( $ua, $symbol, $begin_time ) = @_;
    my %args = (
            'symbol' => $symbol,
            'begin' => $begin_time,
            'period' => 'day',
            'type' => 'before',  # 前复权
            'count' => '1000',     # 向前(时间节点递增)提取
            'indicator' => 'kline,ma',
        );

    my $retry = 0;
    while ( $retry < 5 )
    {
        my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
        my $data = $res->json;
        if ( exists $data->{'data'}{'item'} )
        {
            return $data;
            # printf "%d\n", scalar @{$data->{'data'}{'item'}};
            last;
        }
        else
        {
            printf "%s Retry: %d\n", $symbol, $retry;
            last if ( $retry++ >= 5 );
        }
    }

    return undef;
}

sub xq_kline_data_to_db
{
    my ($dbh, $tb_name, $file) = @_;

    my ( $code ) = ($file =~ /[A-Z]+(\d{6})/);

    my @items = qw/
        symbol date volume open high low close ma5 ma10 ma20 ma30 涨跌幅 换手率
    /;

    my $items_insert = join(",", @items);
    my $placeholds = join(", ", map {"?"} @items );

    # 使用prepare方法准备插入SQL语句。然后，我们使用execute方法执行插入操作，并传递相应的参数。
    my $insert = $dbh->prepare(
        utf8("INSERT INTO [${tb_name}] (${items_insert}) VALUES (${placeholds})")
    );

    my $data = from_json( uni(scalar(read_file( $file ))) );

    # 雪球返回数据的列标
    my @keys = @{$data->{'column'}};

    for my $e ( @{$data->{'item'}} )
    {
        my %kv = zip @keys, @{$e};

        $kv{'time'} = time2str("%Y-%m-%d", $kv{'timestamp'} /1000);

        # 雪球返回的成交量是股为单位，歪枣网的数据是"手" 为单位
        $kv{'volume'} = int($kv{'volume'}/100.0);

        # 振幅 - 振幅的参考基数是昨天的收盘价  (最高-最低)/(昨收)*100.0
        # 所以振幅留到后续再补充

        $insert->execute( $code, @{kv}{qw/time volume open high low close ma5 ma10 ma20 ma30 percent turnoverrate /} );
    }

    $insert->finish;
}


sub update_MA
{
    my ( $dbh, $tb_name ) = @_;
    
    my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM [${tb_name}]" );

    my $curr = 0;
    my $total = scalar @$codes;
    for my $code ( @$codes )
    {
        $curr++;
        printf "[%d/%d] %s\n", $curr, $total, $code;

        # 先获取单个标的的所有 id 映射表，在写入数据时通过id索引定位节点，达到提速效果
        # ORDER BY date ASC => 按日期排序 - 升序
        my $query = $dbh->prepare( utf8("SELECT * FROM [${tb_name}] WHERE symbol = ? ORDER BY date ASC") );
        $query->execute( $code );
        my $rows = $query->fetchall_arrayref( {} );
        my $total = scalar @$rows;

        for my $days ( 60, 120, 250 )
        {
            next if $total < $days;

            my $days_float = $days * 1.0;
            my $sth = $dbh->prepare( utf8("UPDATE [${tb_name}] SET ma${days} = ? WHERE id = ?") );

            for my $idx ( $days-1 .. $#$rows )
            {
                next if defined $rows->[$idx]{"ma$days"}; # 如果已有均线数据，跳过
                # printf "%d - %d\n", $days, $idx;
                my $sum = sum( map { $_->{'close'} } @{$rows}[ $idx-$days+1 .. $idx ] ); # 6 7 8 9 10 when idx = 10, ma = 5
                my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$idx]{'id'} );
                die if ( $result == -1 or $result eq "0E0" );
            }
        }

        # print decode('utf8', dump_json($rows));
        # print $rows->[1][0];
    }
}

# 获取带 SZ SH BJ 前缀的股票代码清单
sub get_symbol_list_with_prefix
{
    my ( $ua ) = @_;
    my %args = (
            'code' => "All",  # 全部
            'fields' => 'code,stype', # 股票代码, 股票类型，1：深证股票，2：上证股票，3：北证股票，4：港股
            'token' => $TOKEN,
            'export' => "1",
            # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;
    my @list;

    my $TYPE = { 1 => "SZ", 2 => "SH", 3 => "BJ", 4 => "HK" };

    for my $e ( @{$res->json->{'data'}} )
    {
        my $code = $TYPE->{ $e->{'stype'} } . $e->{'code'};
        push @list, $code;
    }

    return @list;
}

sub get_symbol_list
{
    my ( $ua ) = @_;
    my %args = (
            'code' => "All",  # 全部
            'fields' => 'code,name', # 股票代码
            'token' => $TOKEN,
            'export' => "1",
            # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;

    my @list = map { $_->{'code'} } @{$res->json->{'data'}};
    return @list;
}

sub abort
{
    my ( $dbh ) = @_;
    
    $dbh->rollback;
    exit;
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

523066680

均线数据虽然说有些网站也提供，但是像雪球只提供MA5 10 20 30 60，其他的没有了，写一套罢~
--

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use List::Util qw/sum/;
use Math::Round qw/nearest_floor nlowmult/;
# use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

$dbh->begin_work;
# 从日K数据表中获取股票名单
# DISTINCT 关键字用于去重
my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );

my $curr = 0;
my $total = scalar @$codes;
for my $code ( @$codes )
{
    $curr++;
    printf "[%d/%d] %s\n", $curr, $total, $code;

    # 先获取单个标的的所有 id 映射表，在写入数据时通过id索引定位节点，达到提速效果
    # ORDER BY date ASC => 按日期排序 - 升序
    my $query = $dbh->prepare( utf8("SELECT id,symbol,date,close FROM 日K WHERE symbol = ? ORDER BY date ASC") );
    $query->execute( $code );
    my $rows = $query->fetchall_arrayref( {} );
    my $total = scalar @$rows;

    for my $days ( 5, 10, 20, 30, 60, 120, 250 )
    {
        next if $total < $days;

        my $days_float = $days * 1.0;
        my $sth = $dbh->prepare( utf8("UPDATE 日K SET ma${days} = ? WHERE id = ?") );

        # 更新N日均线的第一个节点数值
        my $sum = sum( map { $_->{'close'} } @{$rows}[ 0 .. $days-1 ] );
        $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$days-1]{'id'} );

        for my $iter ( $days .. $#$rows )
        {
            $sum += $rows->[$iter]{'close'} - $rows->[$iter-$days]{'close'};
            my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$iter]{'id'} );
            die if ( $result == -1 or $result eq "0E0" );

            # printf "%s ma%d %.3f\n", $rows->[$iter]{'date'}, $days, $sum/5.0;
        }
    }


    # print decode('utf8', dump_json($rows));
    # print $rows->[1][0];
}

$dbh->commit;
$dbh->disconnect;

sub query_stock_data
{
    my ($symbol, $date) = @_;

    my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ? AND date = ?") );
    my $result = $query->execute($symbol, $date) or die;

    printf $result;

    # while (my $row = $query->fetchrow_hashref())
    # {
    #     print  uni(dump_json( $row ));
    # }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

523066680

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

1. baseinfo_all.json

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $token = '歪枣网TOKEN';

=info
    getCompany 的信息相对更详细，但是需要订阅接口权限
    getBaseInfo 包含基本的股票概念(板块)、流通市值、上市日期 等信息
=cut

my %args = (
        #'code' => "601949",
        'code' => "all",
        'type' => 1, # 1|沪深京A股；2|沪深京B股；3|港股；4|美股；5|黄金；6|汇率；7|Reits；10|沪深指数；11|香港指数；12|全球指数；13|债券指数；20|场内基金；30|沪深债券；40|行业板块；41|概念板块；42|地域板块
        'fields' => 'code,name,stype,bk,ssdate,z50,z52,z53',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
        'token' => $token,
        'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );

my $ua = Mojo::UserAgent->new();
# print u2gbk( $res->body );
my $res = $ua->get( "http://api.waizaowang.com/doc/getBaseInfo", form => \%args )->result;

# 还有一些板块信息，在 另一个接口中提供
# getCompanyInfo?code=600187&fields=code,name,mainbusin

my $data = $res->json;
my @codes = map { $_->{'code'} } @{$data->{'data'}};
my $total = scalar @{$data->{'data'}};
my $count = 0;
my %busin_map;

while ( scalar(@codes) > 0 )
{
    my @parts = splice @codes, 0, 50;
    my $main_business = 获取主营业务( $ua, join(",", @parts) );

    for my $e ( @$main_business )
    {
        $busin_map{ $e->{'code'} } = $e->{'mainbusin'};
    }
    # printf "%s\n", gbk( dump_json ($main_business));
    # last;

    printf "%d/%d\n", $count, $total;
    $count+=50;
}

for my $e ( @{$data->{'data'}} )
{
    my $code = $e->{'code'};
    my $main_business = $busin_map{$code};
    $main_business = "" if not defined $main_business;
    my $concept = $e->{'z53'} .";". $main_business;
    $e->{'concept'} = $concept;
}

# print u2gbk($res->body);
write_file( "baseInfo_all.json", utf8(dump_json( $data )) );

# stype 值对照 - 1：深证股票，2：上证股票，3：北证股票，4：港股

# 返回 JSON 数据时有效性判断
# if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
# {
#     print gbk(dump_json($res->json->{'data'}[0]));
# }
# else
# {
#     print gbk(dump_json($res->body));
# }

sub 获取主营业务
{
    my ( $ua, $codes_str ) = @_;
    my %args = (
        'code' => $codes_str,
        'fields' => 'code,mainbusin',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
        'token' => $token,
        'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );
    my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo", form => \%args )->result;

    return $res->json->{'data'};
}


sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }

__DATA__
# R：融资融券标的，也就是说这只股票是融资融券的标的股;
# K：科创板股票，科创板资金门槛50万;涨跌幅20%;
# S：还没进行完股改，涨跌幅5%;
# ST：连续两年亏损或被处理的股票，涨跌幅5%;
# *ST：连续三年亏损，有退市风险，投资者应谨慎参与;
# N：当日上市股票，出现带有N字母的股票，其首日涨跌幅不受限制;
# NST：经过重组或者股改重新上市的ST股;
# PT：已经退市股票;
复制代码

2. concept.json

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

binmode( STDOUT, ":encoding(gbk)");

my $token = '歪枣网TOKEN';

my $baseinfo = from_json( uni(scalar(read_file( "baseinfo_all.json" ))) );
my $concept = {};

printf "total: %d\n", scalar @{$baseinfo->{'data'}};

my $except = qr/(昨日连板_含一字|昨日涨停_含一字|HS300_|深圳特区|AB股|AH股|QFII重仓|预盈预增|预亏预减|机构重仓|沪股通|深成500|中证\d+|上证\d+|深证100R|央视50_|融资融券|证金持股|深股通|MSCI中国|富时罗素|标准普尔|破净股)/;
for my $e ( @{$baseinfo->{'data'}} )
{
    my $cpt = join(",", ($e->{'z52'},$e->{'z53'},$e->{'z50'}) );
    $cpt =~ s/${except},?//g;
    my @cps = grep { $_ !~ /^[_-]$/ } split( /[,;]/, $cpt );

    # printf "%s %s\n", $e->{'code'}, $cpt;
    $concept->{$e->{'code'}} = [ @cps ];
}

write_file( "concept.json", utf8(dump_json( $concept )) );

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

3. index.json 主要是 名称 <=> 代码的 相互映射

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $token = '歪枣网TOKEN';

my %args = (
        'code' => "All",  # 全部
        'fields' => 'code,name,z50,z53', # 股票代码、股票名称、归属行业板块名称、归属概念板块名称
        'token' => $token,
        'export' => "1",
        # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );

my $ua = Mojo::UserAgent->new();
my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;

# print u2gbk( $res->body );
my %hash;
my @list = @{$res->json->{'data'}};
for my $e ( @list )
{
    # 除权、除息股票，获取原名
    # DR：除权除息;表示当日是该只股票的除权除息日;
    # XD：除息日，这只股票的除息日;
    # XR：除权日，这只股票的除权日。

    if ( $e->{'name'} =~ /^(XD|XR|RD)/i )
    {
        my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo", 
                            form => {
                                code => $e->{'code'},
                                fields => 'name',
                                export => '1',
                                token => $token
                            }
                        )->result;

        if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
        {
            # printf "%s => %s\n", gbk($e->{'name'}), gbk( $res->json->{'data'}[0]{'name'} );
            $e->{'name'} = $res->json->{'data'}[0]{'name'};
        }
    }

    $e->{'name'} =~ s/\s//g;
    $hash{'index_by_code'}{ $e->{'code'} } = $e->{'name'};
    $hash{'index_by_name'}{ $e->{'name'} } = $e->{'code'};
}

# 数量
printf "total: %d\n", scalar( keys %{$hash{'index_by_code'}} );

write_file( gbk("index.json"), utf8(to_json(\%hash, {pretty => 1, canonical => 1 } )) );


sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

index.json 形式如下

{
   "index_by_code" : {
      "000001" : "平安银行",
      "000002" : "万科Ａ"
   },
   "index_by_name" : {
      "平安银行" : "000001",
      "万科Ａ" : "000002"
   }
}
复制代码

xczxczxcz

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

523066680

回复 11# xczxczxcz


    我做娱乐用，在Perl区没有人，刷存货代码呢（一天发一段挤牙膏）。这个项目带点实质性数据展示，龙虎榜可视化之类
我24年接下来的项目，完完全全纯娱乐（没卵用就对了），炫就完事，基本也不适合发这边。

523066680

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

数据文件清单

index.json - 股票名称 代码映射表
baseInfo_all.json - 基本信息表
concept.json - 概念映射表
stock_data.sqlite - 日K、均线历史数据
复制代码

以下是Perl模块：DrawKlineMA.pm 代码

package DrawKlineMA;

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use List::Util qw/sum max min/;
use List::MoreUtils qw/zip/;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
use Image::Magick;

sub Draw
{
    my ( $code, $name, $data, $concept, $export ) = @_;

    if ( -f gbk($export) )
    {
        # printf "png file already exists\n";
        # return;
    }
    
    if ( $#$data < 80 )
    {
        printf "the data quantity less than 80\n";
    }
    else
    {
        @$data = @{$data}[-80 .. -1];
    }

    # 创建一个新的图片对象
    my $image = Image::Magick->new(size => '1200x500');
    $image->Read('xc:white');

    my $layer1 = Image::Magick->new(size => '1200x500');
    $layer1->Read('xc:none');
     
    my ( $W, $H ) = ( $image->Get("width"), $image->Get("height") );

    # 设置绘图参数
    my $bar_width = 10;  # K线的宽度
    my $padding = 3;   # K线之间的间距
    my $max_value = max( map { $_->{'high'} } @$data );
    my $min_value = min( map { $_->{'low'} } @$data );
    my $bar_delta = $max_value - $min_value;

    my $max_volume = max( map { $_->{'volume'} } @$data );

    my $VOL_BASE = $H * 0.2;
    my $VOL_MAX_H = $H * 0.1;

    my $BAR_BASE = $VOL_BASE + $VOL_MAX_H + 10;
    my $BAR_MAX_H = $H * 0.5;

    # 两融数据 - 考虑数据中有NULL的情况
    my @margin_data = grep { defined $_ } map { $_->{utf8('融券余额')} } @$data;
    my $margin_max = max( @margin_data );
    my $margin_min = min( @margin_data );
    my $margin_delta = scalar(@margin_data) > 0 ? $margin_max - $margin_min : undef;
    my $margin_sum = sum( @margin_data );

    # 绘制外框
    # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $VOL_BASE, $VOL_BASE+$VOL_MAX_H, "none", "gray" );

    # 绘制外框
    # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $BAR_BASE, $BAR_BASE+$BAR_MAX_H, "none", "gray" );

    my @words = split /,/, $concept;
    my $buff = "";
    while ( @words )
    {
        $buff .= join(", ", splice(@words, 0, 10)) ."\n";
    }

    # 板块信息
    $image->Annotate(
        text      => $buff,
        x         => int($W*1/4),
        y         => 20,
        fill      => 'black',
        font      => "Simhei",
        pointsize => 16,
        align     => 'left',
        gravity => "SouthWest",
        'word-break' => 'break-word',
    );

    # 股票名称
    $image->Annotate(
        text      => sprintf("%s(%s)", $name, $code),
        x         => 10,
        y         => 28,
        fill      => 'black',
        font      => "Simhei",
        pointsize => 28,
        align     => 'left',
        gravity => "SouthWest",
    );

    # 绘制K线图
    my $x = $padding;
    
    # 均线起点值
    my $prev = {};
    my @ma_list = qw/ma5 ma10 ma20 ma30 ma60 ma120 ma250/;
    my @colors = qw/black orange pink green blue purple brown cyan/;
    my $mcolor = {};
    my $cid = 0;

    # 初始化均线起点值，但也要考虑某些标的，长周期分均线一开始并未出现的情况
    for my $ma ( @ma_list )
    {
        $mcolor->{$ma} = $colors[$cid++];
        $prev->{$ma} = $data->[0]->{$ma};
    }

    $prev->{'margin'} = $data->[0]->{'融券余额'};

    my $prev_close = 0.0;
    for my $kline ( @$data )
    {
        my $date = $kline->{date};
        my $open = $kline->{open};
        my $high = $kline->{high};
        my $low = $kline->{low};
        my $close = $kline->{close};
        my $volume = $kline->{volume};

        # 计算K线的高度
        my $delta = abs($open - $close);
        my $bar_open = ($open - $min_value )/ $bar_delta * $BAR_MAX_H;
        my $bar_close = ($close - $min_value )/ $bar_delta * $BAR_MAX_H;

        # 上下影线位置
        my $bar_high = ($high - $min_value )/ $bar_delta * $BAR_MAX_H;
        my $bar_low = ($low - $min_value )/ $bar_delta * $BAR_MAX_H;

        # 颜色 - 下跌时为绿色实心，上涨或者不涨为白色实心、红色边界
        my $fill = $close > $open ? "white" : "green";
        my $stroke = $close > $open ? "red" : "green";

        # 如果是一字上涨
        if ( $close == $open and $close > $prev_close )
        { $fill = "white"; $stroke = "red"; }

        # 绘制上下影线
        draw_line_range( $image, $x+$bar_width/2, $BAR_BASE+$bar_high, $BAR_BASE+$bar_low, $stroke );

        # printf "%.2f %.2f %d %d\n", $high, $low, $bar_high, $bar_low;
        # 绘制K柱
        draw_rect_range( $image, $x, $x+$bar_width, $BAR_BASE+$bar_open, $BAR_BASE+$bar_close, $fill, $stroke );

        # 绘制量能条
        my $volume_height = $volume / $max_volume * $VOL_MAX_H;
        draw_rect_range( $image, $x, $x+$bar_width, $VOL_BASE, $VOL_BASE+$volume_height, $fill, $stroke );

        # 绘制融券数据
        if ( defined $kline->{utf8('融券余额')} and $margin_sum != 0 )
        {
            my $k = utf8("融券余额");
            if ( not defined $prev->{$k}  )
            {
                $prev->{$k} = $kline->{$k};
            }
            else
            {
                # printf "%.2f\n", $kline->{$k};
                # pt1 是上一个点的位置 pt2是当前点的位置
                my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H }; 
                my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H }; 
                draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, "CYAN" );
                $prev->{$k} = $kline->{$k};
            }
        }

        # 绘制均线
        for my $ma ( @ma_list )
        {
            # 考虑某些标的，长周期分均线一开始并未出现的情况；先记录数据，留到下一节点绘制
            if ( not defined $prev->{$ma} )
            {
                $prev->{$ma} = $kline->{$ma};
                next;
            }

            # pt1 是上一个点的位置 pt2是当前点的位置
            my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H }; 
            my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H }; 
            draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, $mcolor->{$ma} );

            $prev->{$ma} = $kline->{$ma};
        }

        # 日期字符串长度
        my @mertics = $image->QueryFontMetrics(text => $date, font => 'Arial', pointsize => 12 );
        my $text_width = $mertics[4];

        # 绘制日期
        my $text_x = $x;
        my $text_y = $VOL_BASE;
        $image->Annotate(
            text      => $date,
            x         => $text_x + $padding/2,
            y         => $H - $VOL_BASE + $text_width/2 + $padding,
            rotate    => 90,
            fill      => 'black',
            # stroke    => 'black',
            font      => 'Arial',
            pointsize => 12,
            align     => 'Center',
            gravity => "South",
        );

        # 更新X轴位置
        $x += $bar_width + $padding;
        $prev_close = $close;
    }

    $layer1->Evaluate( channel => "Alpha", operator => "Multiply", value => 0.6 );
    $image->Composite( image => $layer1 );

    $image->Set( "Alpha" => "On");

    # 保存图像
    $image->Write( $export );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_line
{
    my ( $cv, $x1, $y1, $x2, $y2, $color, $strokewidth ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'line',
        points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
        stroke    => $color,
        strokewidth => 1.0
    );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_line_range
{
    my ( $cv, $x, $y1, $y2, $color ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'line',
        points    =>  sprintf("%d,%d %d,%d", $x, $h-$y1, $x, $h-$y2 ),
        stroke    => $color
    );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_rect_range
{
    my ( $cv, $x1, $x2, $y1, $y2, $fill, $stroke ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'rectangle',
        points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
        fill      => $fill,
        stroke    => $stroke,
    );
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }

1;
复制代码

现在，可以做一些特征筛选、板块组合筛选，并且批量生成走势图的操作。
按板块筛选并且批量绘图的脚本：

use utf8;
use Encode;
use Modern::Perl;
use DBI;
use File::Slurp;
use File::Path qw/make_path/;
use File::Basename;
use Mojo::UserAgent;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use List::Util qw/max min sum/;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

use FindBin;
use lib $FindBin::Bin;
use DrawKlineMA;

# 数据库路径不需要转换为GBK
my $db = "stock_data.sqlite";
my $dbh = DBI->connect("dbi:SQLite:dbname=$db") or die "can not connect DB: $DBI::errstr";

my $codes_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );
my $total_in_db = scalar @$codes_in_db;

# 股票代号 - 名称 对照表
my $index = from_json( uni(scalar(read_file( "index.json" ))) );
my $baseinfo_all = from_json( uni(scalar(read_file( "baseInfo_all.json" ))) );
my $concept;
for my $e ( @{$baseinfo_all->{'data'}} )
{
    $concept->{$e->{code}} = $e->{'concept'} .",". $e->{'z52'};
}

my $output_dir = "./先进封装";
mkdir gbk($output_dir) unless -d gbk($output_dir);

for my $code ( @$codes_in_db )
{
    next if $code =~ /TEST/i;
    # next unless $code eq "001268";
    # printf "current: %s\n", $code;

    my $name = exists $index->{'index_by_code'}{$code} ? $index->{'index_by_code'}{$code} : "unknow";
    my $data = load_kline_data( $dbh, $code, 90 );
    
    # 如果少于90天，PASS
    next if scalar( @$data ) < 90;
    # 工业母机 工业4.0
    # 一带一路 and 新疆
    if ( not exists $concept->{ $code } )
    {
        printf "${code}: concept not found\n";
        next;
    }

    next unless $concept->{ $code } =~ /钙钛/;
    next unless $concept->{ $code } =~ /半导体/;

    # next unless $concept->{ $code } =~ /华为/;
    # next unless $concept->{ $code } =~ /ChatGPT/;

    printf "%s %s\n", $code, gbk($name);

    # next;

    my $export = "${output_dir}/${code}-${name}.png";
    DrawKlineMA::Draw( $code, $name, $data, $concept->{$code}, $export );
}

sub load_kline_data
{
    my ( $dbh, $code, $n ) = @_;

    # 查询数据
    my $query = "SELECT * FROM 日K WHERE symbol = ? ORDER BY date DESC LIMIT ?";

    # selectall_arrayref 函数可以返回带列标名称的哈希数据
    # $n 表示要获取的行数
    my $result = $dbh->selectall_arrayref($query, { Slice => {} }, $code, $n);
    # print dump_json( $result );

    @$result = reverse @$result;
    return $result;
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

生成的图片样张，其中青蓝色的是融券数据（最近懒得更新了所以止步12月）
-


这样一张图竟然需要3~5秒，无法忍受，于是就重新勾起了远古的回忆 —— 为什么不用OpenGL渲染？下回再说。

523066680

Image::Magick 绘制一张60天左右的K线图，耗时3~5秒，有可能是因为大量的日期文字软渲染，这不重要，重要的是有效率碾压的替代方案。
大致的思路：
1. 根据代码和日期范围，加载数据库数据，计算有效天数
2. 使用OpenGL接口创建FBO 帧缓冲对象，根据天数判定并设置"画布"宽度
3. 绘制
4. FBO转纹理导出图片
实测 180天数据，日K+30分钟K+周K+资金流入流出数据，大约3000x2000像素的图片，耗时0.5秒。其中大部分耗时可能来自文本的矢量字形处理，以及频繁的drawcall，没有打包成VBO，还有很大的优化空间。

    //创建 fbo 根据日期范围决定 画布宽度
    int fbo_width = (int)(bar_width + padding) * count_of_days + 100;
    fbo = gl::Fbo::create(fbo_width, canvas_h, fbo_fmt);

    cout << "fbo_width:" << fbo_width << endl;
复制代码

绑定渲染对象为 fbo，并设置视景范围

        fbo->bindFramebuffer();
        gl::viewport(0, 0, w, h);
        mCam.setOrtho( -center.x, center.x, -center.y, center.y, 0.1, 1000.0);
复制代码

绘制

FBO转纹理导出图片

writeImage( fs::path( imgfile ), fbo->getColorTexture()->createSource() ); 
复制代码

样张：


样张2, 4690x1850

523066680

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

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


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

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


大部分时候都没有考虑性能问题，怎么粗暴怎么堆。
然后一个成交量的柱子，除了位置平移表示其成交价格的变化，填充的比例表示实际成交的比例。还考虑加一种填充方式表示10W以内的小单，因为多种颜色实在是太花哨了，后来就改用斜纹。
这里为了速度还是得用一下片段着色器，
做一个小小的数学题，给定一个方形的所有像素点，如何画一条斜线？y==x ，如何画很多条间隔斜线？(x+y) % 2 == 1 ；要控制3个像素为一个间隔 (x+y) % 6 >= 3

        uniform int hint;
        uniform vec4 color1;
        uniform vec4 color2;
        uniform int left;
        out vec4 FragColor;

        void main( void )
        {
            ivec2 coord = ivec2(gl_FragCoord.xy);

            if ( (coord.x-left+coord.y) % 6 > hint ) {
                FragColor = color1;
            } else {
                FragColor = color2;
            }
        }
复制代码

改完以后是这样的：