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

Okelani

回复 30# 523066680

19楼

523066680

回复 31# Okelani

原来是这个问题，都怪 CU论坛。

情节可以很简单

回复 30# 523066680

唉，看到你们“志同道合”的样子 羡慕嫉妒恨啊！！
扶我扶我就扶我~map出来了。我来试试坐标吧。

给跪！

523066680

回复 33# 情节可以很简单

多谢打赏。CU 这方面还可以。就是人气越来越少了。

要带坐标的话，把字符间隔改为 tab 然后整个粘贴到 excel，这样不用考虑坐标字符宽度。

Tab:

1. use List::Util qw/max min/;
   
2. STDOUT->autoflush(1);
   
3. 
   
4. my @data = read_file("bgr_trim8.txt");
   
5. 
   
6. our ( @X, @Y, @Z, %edge );
   
7. for my $row ( @data )
   
8. {
   
9.     $row=~/\((-?\d+),(-?\d+)\)\s+(\w+)/;
   
10.     push @X, $1;
    
11.     push @Y, $2;
    
12.     push @Z, $3;
    
13. }
    
14. 
    
15. %edge = (
    
16.     'x' => { 'min' => min( @X ), 'max' => max( @X ) },
    
17.     'y' => { 'min' => min( @Y ), 'max' => max( @Y ) },
    
18. );
    
19. 
    
20. our @buffer;
    
21. create_buffer();
    
22. draw_buffer();
    
23. #<STDIN>;
    
24. 
    
25. sub draw_buffer
    
26. {
    
27.     our ( @X, @Y, @Z, %edge );
    
28.     my ($x, $y, $str);
    
29. 
    
30.     # 数据填入
    
31.     for my $id ( 0 .. $#X )
    
32.     {
    
33.         $x = $X[$id] - $edge{x}{min};
    
34.         $y = $Y[$id] - $edge{y}{min};
    
35.         $buffer[ $y ][ $x+1 ] = $Z[$id];
    
36.     }
    
37. 
    
38.     $str = join "\n", map { join("\t", @$_ ) } ( @buffer );
    
39.     write_file("tab.txt", $str );
    
40. }
    
41. 
    
42. sub create_buffer
    
43. {
    
44.     my $dtx = $edge{x}{max} - $edge{x}{min} + 1;
    
45.     my $dty = $edge{y}{max} - $edge{y}{min} + 1;
    
46. 
    
47.     my $realy;
    
48.     for my $row ( 1 .. $dty )
    
49.     {
    
50.         $realy = $edge{y}{min} + $row - 1;
    
51.         push @buffer, [ $realy, ("") x $dtx, $realy ];
    
52.     }
    
53. 
    
54.     #添加 x 坐标轴
    
55.     push @buffer, [ "", map { $_ } ( int($edge{x}{min}) .. int($edge{x}{max}) ) ];
    
56.     unshift @buffer, $buffer[$#buffer];
    
57. }
    
58. 
    
59. sub read_file
    
60. {
    
61.     open my $fh, "<", $_[0];
    
62.     return (<$fh>);
    
63. }
    
64. 
    
65. sub write_file
    
66. {
    
67.     open my $fh, ">", $_[0];
    
68.     print $fh $_[1];
    
69.     close $fh;
    
70. }

复制代码

Excel 版：

1. use Win32::OLE qw (in with);
   
2. use Win32::OLE::Const ('Microsoft Excel');
   
3. use Win32::OLE::Variant;
   
4. use List::Util qw/max min/;
   
5. STDOUT->autoflush(1);
   
6. use Cwd;
   
7. my $cwd = getcwd();
   
8. $cwd=~s/\//\\/g;
   
9. 
   
10. our $ex;
    
11. our $book;
    
12. our $sheet;
    
13. create_sheet();
    
14. 
    
15. my @data = read_file("bgr_trim8.txt");
    
16. 
    
17. our ( @X, @Y, @Z, %edge );
    
18. for my $row ( @data )
    
19. {
    
20.     $row=~/\((-?\d+),(-?\d+)\)\s+(\w+)/;
    
21.     push @X, $1;
    
22.     push @Y, $2;
    
23.     push @Z, $3;
    
24. }
    
25. 
    
26. %edge = (
    
27.     'x' => { 'min' => min( @X ), 'max' => max( @X ) },
    
28.     'y' => { 'min' => min( @Y ), 'max' => max( @Y ) },
    
29. );
    
30. 
    
31. our @buffer;
    
32. create_buffer();
    
33. draw_buffer();
    
34. save_sheet( $cwd ."\\data.xlsx" );
    
35. 
    
36. sub draw_buffer
    
37. {
    
38.     our ( @X, @Y, @Z, %edge );
    
39.     my ($x, $y, $str);
    
40. 
    
41.     # 数据填入
    
42.     for my $id ( 0 .. $#X )
    
43.     {
    
44.         $x = $X[$id] - $edge{x}{min};
    
45.         $y = $Y[$id] - $edge{y}{min};
    
46.         $buffer[ $y ][ $x+1 ] = $Z[$id];
    
47.         $sheet->cells( $y+2, $x+2 )->{Value} = $Z[$id];
    
48.     }
    
49. 
    
50. }
    
51. 
    
52. sub create_buffer
    
53. {
    
54.     my $dtx = $edge{x}{max} - $edge{x}{min} + 1;
    
55.     my $dty = $edge{y}{max} - $edge{y}{min} + 1;
    
56. 
    
57.     my $realy;
    
58.     for my $row ( 1 .. $dty )
    
59.     {
    
60.         $realy = $edge{y}{min} + $row - 1;
    
61.         $sheet->cells( $row+1, 1 )->{Value} = $realy;
    
62.         $sheet->cells( $row+1, $dtx+2 )->{Value} = $realy;
    
63.     }
    
64. 
    
65.     #添加 x 坐标轴
    
66.     for my $col ( 1 .. $dtx )
    
67.     {
    
68.         $realx = $edge{x}{min} + $col + 1;
    
69.         $sheet->cells( 1, $col+1 )->{Value} = $realx;
    
70.         $sheet->cells( $dty + 2, $col+1 )->{Value} = $realx;
    
71.         $sheet->columns( $col )->{ColumnWidth} = 2;
    
72.     }
    
73. 
    
74.     $sheet->columns( $dtx+1 )->{ColumnWidth} = 2;
    
75.     $sheet->columns( $dtx+2 )->{ColumnWidth} = 2;
    
76. }
    
77. 
    
78. sub create_sheet
    
79. {
    
80.     our $ex;
    
81.     our $book;
    
82.     our $sheet;
    
83.     # use existing instance if Excel is already running
    
84.     eval { $ex = Win32::OLE->GetActiveObject('Excel.Application') };
    
85.     die "Excel not installed" if $@;
    
86. 
    
87.     unless ( defined $ex ) {
    
88.         $ex = Win32::OLE->new('Excel.Application', sub { $_[0]->Quit; })
    
89.                 or die "Oops, cannot start Excel";
    
90.     }
    
91. 
    
92.     #new workbook
    
93.     $book = $ex->Workbooks->Add;
    
94.    
    
95.     # write to a particular cell
    
96.     $sheet = $book->Worksheets(1);
    
97. }
    
98. 
    
99. sub save_sheet
    
100. {
     
101.     my $file = shift;
     
102.     our $ex;
     
103.     our $book;
     
104.     our $sheet;
     
105.     # save and exit
     
106.     $ex->{DisplayAlerts} = 'False';
     
107.     $book->SaveAs( $file );
     
108.     undef $sheet;
     
109.     undef $book;
     
110.     undef $ex;
     
111. }
     
112. 
     
113. sub read_file
     
114. {
     
115.     open my $fh, "<", $_[0];
     
116.     return (<$fh>);
     
117. }
     
118. 
     
119. sub write_file
     
120. {
     
121.     open my $fh, ">", $_[0];
     
122.     print $fh $_[1];
     
123.     close $fh;
     
124. }

复制代码