[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 523066680 于 2023-3-3 22:25 编辑

源自某一个需求,要把多种变换合并成的矩阵解算还原成  旋转角度值、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. my $mt_str = "matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)";
  11. #提取矩阵拆解的结果
  12. my $mt_info = pack_mt_info( $mt_str );
  13. my ( $ang, $scaleX, $scaleY, $skewX, $x, $y ) = @{$mt_info}{ 'rotate', 'scaleX', 'scaleY', 'skewX', 'x', 'y' };
  14. printf "%s\n\n", $mt_str;
  15. printf "Decompose:\n";
  16. printf "rotate(%.2f) scale(%.2f, %.2f) skewX(%.2f) skewY(%.2f) %d %d\n\n", $ang, $scaleX, $scaleY, $skewX, 0, $x, $y;
  17. # 根据获取的角度值和缩放值,重新创建、合并多种变换矩阵、验证结果
  18. my $mat =
  19.     Imager::Matrix2d->translate( x => $x, y => $y ) *  # 平移
  20.     Imager::Matrix2d->rotate( degrees => $ang ) *
  21.     Imager::Matrix2d->scale( x => $scaleX, y => $scaleY ) *
  22.     Imager::Matrix2d->shear( x => tan(deg2rad( $skewX )) ) *         #shear参数接受tan(θ)值
  23.     Imager::Matrix2d->identity()
  24.     ;
  25. printf "Compose Matrices Again:\n";
  26. print $mat;
  27. say "";
  28. sub transform_point
  29. {
  30.   my ($x, $y, $matrix) = @_;
  31.   return
  32.     (
  33.      $x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2],
  34.      $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]
  35.     );
  36. }
  37. sub pack_mt_info
  38. {
  39.     my $transform = shift;
  40.     # 矩阵解构
  41.     my ( $scaleX, $scaleY, $skewX, $rotate, $x, $y );
  42.     if ( defined $transform and $transform =~/matrix\((.*)\)/i )
  43.     {
  44.         my ($a, $b, $c, $d, $e, $f) = split( /\s+/, $1 );
  45.         ( $x, $y ) = ( $e, $f );
  46.         ( $scaleX, $scaleY, $skewX, undef, $rotate ) = decompose_scale_skewX_rotate_matrix( $a, $b, $c, $d );
  47.     }
  48.     return {
  49.         'x' => $x, 'y' => $y,
  50.         'scaleX' => nearest(0.000001, $scaleX),
  51.         'scaleY' => nearest(0.000001, $scaleY),
  52.         'rotate' => nearest(0.000001, $rotate),
  53.         'skewX' => nearest(0.000001, $skewX),
  54.     };
  55. }
  56. sub decompose_scale_skewX_rotate_matrix
  57. {
  58.     my ($a, $b, $c, $d) = @_;
  59.     my $pi = 3.151592653;
  60.     my $rad = atan2( $b, $a );
  61.     my $denom = $a **2 + $b ** 2;
  62.     my ($scale_x) = sqrt( $denom );
  63.     my ($scale_y) = ( $a*$d - $b*$c )/ $scale_x;
  64.     my ($skew_x) = atan2( $a * $c + $b * $d, $denom );
  65.     my $skew_y = 0;
  66.     return ( $scale_x, $scale_y, rad2deg( $skew_x ), rad2deg( $skew_y ), rad2deg($rad) );
  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]) }
复制代码
输出
  1. matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)
  2. Decompose:
  3. rotate(-25.00) scale(1.00, -0.51) skewX(37.00) skewY(0.00) 124 135
  4. Compose Matrices Again:
  5. [ 0.9063,    0.8998,    124.3052,
  6.   0.4226,    -0.1465,   135.0586,
  7.   0,         0,         1, ]
复制代码

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

评分人数

TOP

本帖最后由 523066680 于 2023-3-4 19:42 编辑
之前挖的坑,就写了一点点,高斯约旦消元和PLUP'分解一直没填(逃
老刘1号 发表于 2023-3-4 12:47


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

TOP

返回列表