トップページ > プログラム > 2019年05月26日 > XOxN6P/y

書き込み順位&時間帯一覧

3 位/164 ID中時間01234567891011121314151617181920212223Total
書き込み数0000000000000000052000007



使用した名前一覧書き込んだスレッド一覧
130
デフォルトの名無しさん
プログラミングのお題スレ Part14

書き込みレス一覧

プログラミングのお題スレ Part14
133 :130[sage]:2019/05/26(日) 17:27:59.46 ID:XOxN6P/y
>>11 外側の正方形 Perl5、但し>>130>>131の「凸包の一辺が正方形の辺に接する」または「細い菱形のような形が
正方形の対角2点で接する」場合について求てみた。凸包を求める処理は略し、二点間の辺を総当りで計算している。
use List::Util qw{min max pairkeys pairvalues};
@s=qw{136 577 110 927 472 199 157 808 388 598 94 31 388 157 325 409 787 897 850 598};
@X = pairkeys @s; @Y = pairvalues @s;
sub sp {$_[0]*$_[2] + $_[1]*$_[3]}
sub rt {
 @e = (cos $th, -sin $th); @f = (sin $th, cos $th);
 my @x = map{sp @e, $X[$_], $Y[$_]} 0..$#X;
 my @y = map{sp @f, $X[$_], $Y[$_]} 0..$#Y;
 @x = (min(@x), max(@x)); @y = (min(@y), max(@y));
 $h = (max $x[1] - $x[0], $y[1] - $y[0]) / 2;
 $cx = ($x[1] + $x[0]) / 2; $cy = ($y[1] + $y[0]) / 2;
 @x = ($cx - $h, $cx + $h); @y = ($cy - $h, $cy + $h);
 ($e[1], $f[0]) = (-$e[1], -$f[0]);
 @x = map{sp @e, $x[$_], $y[$_]} 0..1;
 @y = map{sp @f, $x[$_], $y[$_]} 0..1;
 @x = (min(@x), max(@x)); @y = (min(@y), max(@y));
 (\@x, \@y, 2*$h) }
for $i (0..@X-2) { for $j ($i+1..$#X) {
 ($dx, $dy) = ($X[$j] - $X[$i], $Y[$j] - $Y[$i]);
 ($dx, $dy) = (-$dx, -$dy) if $dx < 0;
 $l = sqrt($dx*$dx + $dy*$dy);
 $th = $dx > abs($dy) ? -atan2($dy, $dx) : atan2($dx, $dy);
 ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
 $th += 3.14159265358979/4; ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
} }
@t = sort{$a->{w}<=>$b->{w}} grep{0<=$_->{X}[0]and$_->{X}[1]<=999 and 0<=$_->{Y}[0]and$_->{Y}[1]<=999} @t;
do {@x = @{$t[$_]->{X}}; @y = @{$t[$_]->{Y}};
 printf"%d: (%7.3f, %7.3f)-(%7.3f, %7.3f): w=%3.3f\n",$_+1,$x[0],$y[0],$x[1],$y[1],$t[$_]->{w}} for 0..5;
プログラミングのお題スレ Part14
134 :デフォルトの名無しさん[sage]:2019/05/26(日) 17:29:47.07 ID:XOxN6P/y
>>133 の実行例

~ $ perl 14_11.pl
1: ( 48.607, 27.043)-(863.062, 983.177): w=891.576
2: ( 45.920, 20.484)-(869.713, 849.356): w=892.353
3: ( 32.627, 29.170)-(901.066, 949.457): w=895.142
4: ( 24.000, 31.000)-(920.000, 927.000): w=896.000
5: ( 24.000, 31.000)-(920.000, 927.000): w=896.000
6: ( 14.845, 32.823)-(931.567, 907.397): w=896.130


検算してないので、もしバグっていたらゴメンチャイ、(ゝω・) テヘペロ
プログラミングのお題スレ Part14
135 :デフォルトの名無しさん[sage]:2019/05/26(日) 17:38:51.62 ID:XOxN6P/y
>>133 スマソ、「正方形の4点の座標を示せ」と書かれていたので、出力処理を少し修正
use List::Util qw{min max pairkeys pairvalues};
@s=qw{136 577 110 927 472 199 157 808 388 598 94 31 388 157 325 409 787 897 850 598};
@X = pairkeys @s; @Y = pairvalues @s;
sub sp {$_[0]*$_[2] + $_[1]*$_[3]}
sub rt {
 @e = (cos $th, -sin $th); @f = (sin $th, cos $th);
 my @x = map{sp @e, $X[$_], $Y[$_]} 0..$#X;
 my @y = map{sp @f, $X[$_], $Y[$_]} 0..$#Y;
 @x = (min(@x), max(@x)); @y = (min(@y), max(@y));
 $h = (max $x[1] - $x[0], $y[1] - $y[0]) / 2;
 $cx = ($x[1] + $x[0]) / 2; $cy = ($y[1] + $y[0]) / 2;
 @x = ($cx - $h, $cx + $h); @y = ($cy - $h, $cy + $h);
 ($e[1], $f[0]) = (-$e[1], -$f[0]);
 @x = map{sp @e, $x[$_], $y[$_]} 0..1;
 @y = map{sp @f, $x[$_], $y[$_]} 0..1;
 @x = (min(@x), max(@x)); @y = (min(@y), max(@y));
 (\@x, \@y, 2*$h) }
for $i (0..@X-2) { for $j ($i+1..$#X) {
 ($dx, $dy) = ($X[$j] - $X[$i], $Y[$j] - $Y[$i]);
 ($dx, $dy) = (-$dx, -$dy) if $dx < 0;
 $l = sqrt($dx*$dx + $dy*$dy);
 $th = $dx > abs($dy) ? -atan2($dy, $dx) : atan2($dx, $dy);
 ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
 $th += 3.14159265358979/4; ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
} }
@t = sort{$a->{w}<=>$b->{w}} grep{0<=$_->{X}[0]and$_->{X}[1]<=999 and 0<=$_->{Y}[0]and$_->{Y}[1]<=999} @t;
do {@x = @{$t[$_]->{X}}; @y = @{$t[$_]->{Y}};
 printf"%d: (%6.3f, %6.3f), (%7.3f, %6.3f), (%6.3f, %7.3f), (%7.3f, %7.3f): w=%3.3f\n",
  $_+1,$x[0],$y[0],$x[1],$y[0],$x[0],$y[1],$x[1],$y[1],$t[$_]->{w}} for 0..5;
プログラミングのお題スレ Part14
136 :デフォルトの名無しさん[sage]:2019/05/26(日) 17:40:00.54 ID:XOxN6P/y
>>135 実行結果

~ $ perl 14_11.pl
1: (48.607, 27.043), (863.062, 27.043), (48.607, 983.177), (863.062, 983.177): w=891.576
2: (45.920, 20.484), (869.713, 20.484), (45.920, 849.356), (869.713, 849.356): w=892.353
3: (32.627, 29.170), (901.066, 29.170), (32.627, 949.457), (901.066, 949.457): w=895.142
4: (24.000, 31.000), (920.000, 31.000), (24.000, 927.000), (920.000, 927.000): w=896.000
5: (24.000, 31.000), (920.000, 31.000), (24.000, 927.000), (920.000, 927.000): w=896.000
6: (14.845, 32.823), (931.567, 32.823), (14.845, 907.397), (931.567, 907.397): w=896.130

検算してないので、もしバグっていたらゴメンチャイ、(ゝω・) テヘペロ
プログラミングのお題スレ Part14
137 :デフォルトの名無しさん[sage]:2019/05/26(日) 17:44:33.42 ID:XOxN6P/y
>>136
なんか変、バグってるスマソ、直すことが出来たら書き込みます
プログラミングのお題スレ Part14
138 :デフォルトの名無しさん[sage]:2019/05/26(日) 18:33:59.00 ID:XOxN6P/y
>>11 外側の正方形 Perl5 凸包の辺が正方形の辺に接するまたは対角二点で接する場合、>>135の露骨なバグ一個修正
use List::Util qw{min max pairkeys pairvalues};
@s=qw{136 577 110 927 472 199 157 808 388 598 94 31 388 157 325 409 787 897 850 598};
@X = pairkeys @s; @Y = pairvalues @s;
sub sp {$_[0]*$_[2] + $_[1]*$_[3]}
sub rt {
 @e = (cos $th, -sin $th); @f = (sin $th, cos $th);
 my @x = map{sp @e, $X[$_], $Y[$_]} 0..$#X;
 my @y = map{sp @f, $X[$_], $Y[$_]} 0..$#Y;
 @x = (min(@x), max(@x)); @y = (min(@y), max(@y));
 $h = (max $x[1] - $x[0], $y[1] - $y[0]) / 2;
 $cx = ($x[1] + $x[0]) / 2; $cy = ($y[1] + $y[0]) / 2;
 @x = ($cx - $h, $cx + $h, $cx - $h, $cx + $h);
 @y = ($cy - $h, $cy - $h, $cy + $h, $cy + $h);
 ($e[1], $f[0]) = (-$e[1], -$f[0]);
 @x = map{sp @e, $x[$_], $y[$_]} 0..3;
 @y = map{sp @f, $x[$_], $y[$_]} 0..3;
 (\@x, \@y, 2*$h) }
for $i (0..@X-2) { for $j ($i+1..$#X) {
 ($dx, $dy) = ($X[$j] - $X[$i], $Y[$j] - $Y[$i]);
 ($dx, $dy) = (-$dx, -$dy) if $dx < 0;
 $l = sqrt($dx*$dx + $dy*$dy);
 $th = $dx > abs($dy) ? -atan2($dy, $dx) : atan2($dx, $dy);
 ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
 $th += 3.14159265358979/4; ($X, $Y, $w) = &rt;
 push @t, +{i,$i,j,$j,dx,$dx,dy,$dy,l,$l,th,$th,X,$X,Y,$Y,w,$w};
} }
@t = sort{$$a{w}<=>$$b{w}} grep{0<=min@{$_->{X}}and max@{$_->{X}}<=999 and 0<=min@{$_->{Y}}and max@{$_->{Y}}<=999} @t;
do {@x = @{$t[$_]{X}}; @y = @{$t[$_]{Y}};
  printf"%d: (%7.3f,%7.3f), (%7.3f,%7.3f), (%7.3f,%7.3f), (%7.3f,%7.3f): w=%7.3f, th=%7.3f°\n",
   $_+1,$x[0],$y[0],$x[1],$y[1],$x[2],$y[2],$x[3],$y[3],$t[$_]{w},$t[$_]{th}*180/3.14159265358979} for 0..4;
プログラミングのお題スレ Part14
139 :デフォルトの名無しさん[sage]:2019/05/26(日) 18:37:35.18 ID:XOxN6P/y
>>138 実行例

~ $ perl 14_11.pl
1: ( 32.627, 29.170), (927.382, 55.475), ( 6.310,923.152), (901.066,949.457): w=895.142, th= -1.685°
2: (920.000,927.000), ( 24.000,927.000), (920.000, 31.000), ( 24.000, 31.000): w=896.000, th=180.000°
3: ( 24.000, 31.000), (920.000, 31.000), ( 24.000,927.000), (920.000,927.000): w=896.000, th= 0.000°
4: ( 14.845, 32.823), (910.733, 11.994), ( 35.680,928.226), (931.567,907.397): w=896.130, th= 1.332°
5: ( 18.819, 32.332), (914.819, 16.335), ( 34.819,928.046), (930.819,912.049): w=896.143, th= 1.023°

ちゃんと検算してないので、もしまだバグがいたらゴメンチャイ、(ゝω・) テヘペロ

検算方法考えた方がいいのかも。ちなみにwは正方形の幅、thは回転各[deg]

>>11 の内側の正方形についてはまだ考えていない。


※このページは、『2ちゃんねる』の書き込みを基に自動生成したものです。オリジナルはリンク先の2ちゃんねるの書き込みです。
※このサイトでオリジナルの書き込みについては対応できません。
※何か問題のある場合はメールをしてください。対応します。