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

523066680

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

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Math::Trig;
use Math::Round qw/round nearest nearest_floor nearest_ceil/;
use Imager::Matrix2d;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
 
my $mt_str = "matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)";
 
#提取矩阵拆解的结果
my $mt_info = pack_mt_info( $mt_str );
my ( $ang, $scaleX, $scaleY, $skewX, $x, $y ) = @{$mt_info}{ 'rotate', 'scaleX', 'scaleY', 'skewX', 'x', 'y' };
 
printf "%s\n\n", $mt_str;
printf "Decompose:\n";
printf "rotate(%.2f) scale(%.2f, %.2f) skewX(%.2f) skewY(%.2f) %d %d\n\n", $ang, $scaleX, $scaleY, $skewX, 0, $x, $y;
 
# 根据获取的角度值和缩放值，重新创建、合并多种变换矩阵、验证结果
my $mat = 
    Imager::Matrix2d->translate( x => $x, y => $y ) *  # 平移
    Imager::Matrix2d->rotate( degrees => $ang ) * 
    Imager::Matrix2d->scale( x => $scaleX, y => $scaleY ) *
    Imager::Matrix2d->shear( x => tan(deg2rad( $skewX )) ) *         #shear参数接受tan(θ)值
    Imager::Matrix2d->identity()
    ;
 
printf "Compose Matrices Again:\n";
print $mat;
say "";
 
 
sub transform_point
{
  my ($x, $y, $matrix) = @_;
  return
    (
     $x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2],
     $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]
    );
}
 
sub pack_mt_info
{
    my $transform = shift;
 
    # 矩阵解构
    my ( $scaleX, $scaleY, $skewX, $rotate, $x, $y );
    if ( defined $transform and $transform =~/matrix\((.*)\)/i )
    {
        my ($a, $b, $c, $d, $e, $f) = split( /\s+/, $1 );
        ( $x, $y ) = ( $e, $f );
        ( $scaleX, $scaleY, $skewX, undef, $rotate ) = decompose_scale_skewX_rotate_matrix( $a, $b, $c, $d );
    }
 
    return {
        'x' => $x, 'y' => $y,
        'scaleX' => nearest(0.000001, $scaleX), 
        'scaleY' => nearest(0.000001, $scaleY), 
        'rotate' => nearest(0.000001, $rotate),
        'skewX' => nearest(0.000001, $skewX),
    };
}
 
sub decompose_scale_skewX_rotate_matrix
{
    my ($a, $b, $c, $d) = @_;
 
    my $pi = 3.151592653;
    my $rad = atan2( $b, $a );
    my $denom = $a **2 + $b ** 2;
 
    my ($scale_x) = sqrt( $denom );
    my ($scale_y) = ( $a*$d - $b*$c )/ $scale_x;
 
    my ($skew_x) = atan2( $a * $c + $b * $d, $denom );
    my $skew_y = 0;
    return ( $scale_x, $scale_y, rad2deg( $skew_x ), rad2deg( $skew_y ), rad2deg($rad) );
}
 
sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }COPY

输出

matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)
 
Decompose:
rotate(-25.00) scale(1.00, -0.51) skewX(37.00) skewY(0.00) 124 135
 
Compose Matrices Again:
[ 0.9063,    0.8998,    124.3052, 
  0.4226,    -0.1465,   135.0586, 
  0,         0,         1, ]COPY

老刘1号

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

523066680

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

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