[Perl]旋转、倾斜、缩放混合变换矩阵的分解和重组

523066680

源自某一个需求，要把多种变换合并成的矩阵解算还原成  旋转角度值、X倾斜角度值、X/Y缩放值
碰巧 Straberry Perl 自带 Imager::Matrix2d 模块，支持简单的变换矩阵运算，就拿来验证了。

1. use utf8;
   
2. use Encode;
   
3. use Modern::Perl;
   
4. use File::Slurp;
   
5. use Math::Trig;
   
6. use Math::Round qw/round nearest nearest_floor nearest_ceil/;
   
7. use Imager::Matrix2d;
   
8. use JSON qw/from_json to_json/;
   
9. STDOUT->autoflush(1);
   
10. 
    
11. my $mt_str = "matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)";
    
12. 
    
13. #提取矩阵拆解的结果
    
14. my $mt_info = pack_mt_info( $mt_str );
    
15. my ( $ang, $scaleX, $scaleY, $skewX, $x, $y ) = @{$mt_info}{ 'rotate', 'scaleX', 'scaleY', 'skewX', 'x', 'y' };
    
16. 
    
17. printf "%s\n\n", $mt_str;
    
18. printf "Decompose:\n";
    
19. printf "rotate(%.2f) scale(%.2f, %.2f) skewX(%.2f) skewY(%.2f) %d %d\n\n", $ang, $scaleX, $scaleY, $skewX, 0, $x, $y;
    
20. 
    
21. # 根据获取的角度值和缩放值，重新创建、合并多种变换矩阵、验证结果
    
22. my $mat =
    
23.     Imager::Matrix2d->translate( x => $x, y => $y ) *  # 平移
    
24.     Imager::Matrix2d->rotate( degrees => $ang ) *
    
25.     Imager::Matrix2d->scale( x => $scaleX, y => $scaleY ) *
    
26.     Imager::Matrix2d->shear( x => tan(deg2rad( $skewX )) ) *         #shear参数接受tan(θ)值
    
27.     Imager::Matrix2d->identity()
    
28.     ;
    
29. 
    
30. printf "Compose Matrices Again:\n";
    
31. print $mat;
    
32. say "";
    
33. 
    
34. 
    
35. sub transform_point
    
36. {
    
37.   my ($x, $y, $matrix) = @_;
    
38.   return
    
39.     (
    
40.      $x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2],
    
41.      $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]
    
42.     );
    
43. }
    
44. 
    
45. sub pack_mt_info
    
46. {
    
47.     my $transform = shift;
    
48. 
    
49.     # 矩阵解构
    
50.     my ( $scaleX, $scaleY, $skewX, $rotate, $x, $y );
    
51.     if ( defined $transform and $transform =~/matrix\((.*)\)/i )
    
52.     {
    
53.         my ($a, $b, $c, $d, $e, $f) = split( /\s+/, $1 );
    
54.         ( $x, $y ) = ( $e, $f );
    
55.         ( $scaleX, $scaleY, $skewX, undef, $rotate ) = decompose_scale_skewX_rotate_matrix( $a, $b, $c, $d );
    
56.     }
    
57. 
    
58.     return {
    
59.         'x' => $x, 'y' => $y,
    
60.         'scaleX' => nearest(0.000001, $scaleX),
    
61.         'scaleY' => nearest(0.000001, $scaleY),
    
62.         'rotate' => nearest(0.000001, $rotate),
    
63.         'skewX' => nearest(0.000001, $skewX),
    
64.     };
    
65. }
    
66. 
    
67. sub decompose_scale_skewX_rotate_matrix
    
68. {
    
69.     my ($a, $b, $c, $d) = @_;
    
70. 
    
71.     my $pi = 3.151592653;
    
72.     my $rad = atan2( $b, $a );
    
73.     my $denom = $a **2 + $b ** 2;
    
74. 
    
75.     my ($scale_x) = sqrt( $denom );
    
76.     my ($scale_y) = ( $a*$d - $b*$c )/ $scale_x;
    
77. 
    
78.     my ($skew_x) = atan2( $a * $c + $b * $d, $denom );
    
79.     my $skew_y = 0;
    
80.     return ( $scale_x, $scale_y, rad2deg( $skew_x ), rad2deg( $skew_y ), rad2deg($rad) );
    
81. }
    
82. 
    
83. sub gbk { encode('gbk', $_[0]) }
    
84. sub utf8 { encode('utf8', $_[0]) }
    
85. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
    
86. sub uni { decode('utf8', $_[0]) }
    

复制代码

输出

1. matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)
   
2. 
   
3. Decompose:
   
4. rotate(-25.00) scale(1.00, -0.51) skewX(37.00) skewY(0.00) 124 135
   
5. 
   
6. Compose Matrices Again:
   
7. [ 0.9063,    0.8998,    124.3052,
   
8.   0.4226,    -0.1465,   135.0586,
   
9.   0,         0,         1, ]

复制代码

老刘1号

之前挖的坑LinearAlgebra.vbs，就写了一点点，高斯约旦消元和PLUP'分解一直没填（逃

523066680

之前挖的坑，就写了一点点，高斯约旦消元和PLUP'分解一直没填（逃
老刘1号 发表于 2023-3-4 12:47

     有感到满满的压迫感了唉，
不过好在，我刚摆脱桎梏，接下来可以做点有意思的事情了。