TXT中一个坐标列，一个数据列，将数据按坐标生成map

523066680

回复 19# 情节可以很简单

我的TXT版本刚写好，读取 bgr_trim8.txt 数据并输出字符图

1. use File::Slurp;
   
2. use List::Util qw/max min/;
   
3. STDOUT->autoflush(1);
   
4. 
   
5. my @data = read_file("bgr_trim8.txt");
   
6. 
   
7. our ( @X, @Y, @Z, %edge );
   
8. for my $row ( @data )
   
9. {
   
10.     $row=~/\((-?\d+),(-?\d+)\)\s+(\w+)/;
    
11.     push @X, $1;
    
12.     push @Y, $2;
    
13.     push @Z, $3;
    
14. }
    
15. 
    
16. %edge = (
    
17.     'x' => { 'min' => min( @X ), 'max' => max( @X ) },
    
18.     'y' => { 'min' => min( @Y ), 'max' => max( @Y ) },
    
19. );
    
20. 
    
21. dump %edge;
    
22. 
    
23. our @buffer;
    
24. create_buffer();
    
25. draw_buffer();
    
26. <STDIN>;
    
27. 
    
28. sub draw_buffer
    
29. {
    
30.     our ( @X, @Y, @Z, %edge );
    
31.     my ($x, $y, $str);
    
32.     for my $id ( 0 .. $#X )
    
33.     {
    
34.         $x = $X[$id] - $edge{x}{min};
    
35.         $y = $Y[$id] - $edge{y}{min};
    
36.         $buffer[ $y ][ $x ] = $Z[$id];
    
37.     }
    
38. 
    
39.     $str = join "\n", map { join("", @$_ ) } ( @buffer );
    
40.     print $str;
    
41.     write_file("graph.txt", $str );
    
42. }
    
43. 
    
44. sub create_buffer
    
45. {
    
46.     my $dtx = $edge{x}{max} - $edge{x}{min} + 1;
    
47.     my $dty = $edge{y}{max} - $edge{y}{min} + 1;
    
48.     grep { push @buffer, [(".")x$dtx]; } ( 1 .. $dty );
    
49. }
    
50. 
    

复制代码

执行后生成 graph.txt，部分输出（整个发上来太占位）

1. 
   
2. ("y", { max => 73, min => 1 }, "x", { max => 41, min => -36 })
   
3. ...............................A...GFGDGFFFCFEE...............................
   
4. ...........................DFECDGGDGHFFEDEHGFEEDEDG...........................
   
5. ........................EGEDEGEFHGFFEGHFGEGCDEDEFEEDDG........................
   
6. ......................EEGDFGEFEFDEFGGGEFEFFEDBFDFEFEDFDF......................
   
7. ....................FEFHEEDFEGFEGDFEEGFEDFFEFEEGDGEGEFEEEF....................
   
8. ..................EFFFFFFHHFCFEEDDFFFGEFEFEFFFEGEFFDBFDCFFFB..................
   
9. ................EEFGFFCEDFEFFEFEGEGEEEDEFEFFGGEFEFGGDFFEFDHEEF................
   
10. ...............DFDDFDEDFFDDEGGEGDDFDEEDCEHEFEFGDDDGEDEEDGDDEFEF...............
    
11. ..............EEEEFFFEFFEFFEDEFEEGGEEDCFCGDEEEFFFEFEDFEFFBGEFFFD..............
    
12. .............FDGEEEDDCCEFFGFEEFDEDFCFGDF.GEECEEEFDFEDEDEFHEDHDEE..............
    
13. ...........EFGEFHGGEFEFEEFEDEFEDFFCEEGEFFFEGFEGFDDDGDEEDFFFDDFGDFC............
    
14. ..........CDEGEEFFFEEDFGGFGFFDDGFEDFDDDFCCEDFDFFGFDIBFFDFFDEGDFEGEG...........
    
15. .........EHEGGEEEFFEEEGEEGEFCDEFFDEFDDEDFFGFEFFEEDFFFFFFEEEEFFGEEDGC..........
    
16. ........CFFFCDEGGFEGEEEGBDDCDFFCEGFGFFFFEFEDGDCFGEGDEEEDFEEFDEEGFDDGD.........
    

复制代码

情节可以很简单

回复 20# 523066680

真是痛苦，我的Windows不能用这个模块

523066680

回复 21# 情节可以很简单

windows绝对可以的，

执行 cpan install File::Slurp 安装模块

如果安装失败，你可以吧  write_file 和 read_file 函数改成 open $fh, "<", "文件名" 的那一套。

罢了，送两个函数吧，把 use File::Slurp 去掉，追加两个函数

1. sub read_file
   
2. {
   
3.     open my $fh, "<", $_[0];
   
4.     return (<$fh>);
   
5. }
   
6. 
   
7. sub write_file
   
8. {
   
9.     open my $fh, ">", $_[0];
   
10.     print $fh $_[1];
    
11.     close $fh;
    
12. }

复制代码

补个图

情节可以很简单

回复 22# 523066680

我要崩溃了。。。两种方法，
1.第一种注释掉“use File::Slurp;”
将两个读写函数写进去。
结果错误 提示如图一

2.注释掉“use File::Slurp;”和“my @data = read_file("bgr_trim8.txt");”
改为
open M, "<bgr_trim8.txt" or die "Can't open M";
open N, ">map.txt" or die "Can't open N";
our ( @X, @Y, @Z, %edge );
for my $row ( <M> )
{
    $row=~/\((-?\d+),(-?\d+)\)\s+(\w+)/;
    push @X, $1;
    push @Y, $2;
    push @Z, $3;
}

在输出那里改为：

sub draw_buffer
{
    our ( @X, @Y, @Z, %edge );
    my ($x, $y, $str);
    for my $id ( 0 .. $#X )
    {
        $x = $X[$id] - $edge{x}{min};
        $y = $Y[$id] - $edge{y}{min};
        $buffer[ $y ][ $x ] = $Z[$id];
    }

    $str = join "\n", map { join("", @$_ ) } ( @buffer );
    print N, $str;
   # write_file("graph.txt", $str );
}


结果也错，提示图2

情节可以很简单

回复 22# 523066680

发重复了，抱歉。。。

Okelani

回复 24# 情节可以很简单

perl map.pl data > map.txt

Okelani

回复 20# 523066680

    'x' => { 'min' => min( @X ), 'max' => max( @X ) },

Okelani

回复 20# 523066680

18

1.     'x' => { 'min' => fixME
   

复制代码

情节可以很简单

回复 27# Okelani

你们都可以，可是我这就是不行啊我大概可以去屎了。。。。呼~~

523066680

回复 26# Okelani

我用 List::Util ，省心。