Perl Quiz / Puzzle

Perl のクイズ・パズル スレッド

・http://www.hyuki.com/pq/ でやっているやつと同じようなもんだと思ってくれ。
・学校の課題を書くのは禁止な。

------------------終了-----------------------

ということで、お題を。

「タブ文字を展開して空白にする関数を作れ。タブ幅は8とする。」

んじゃべたに。

s/\t/ /g;

あ、ごめん。補足すると、展開するってのは
"x\tx" -> "x_______x"
"xx\tx" -> "xx______x"
"xxx\tx" -> "xxx_____x"
("_" はスペース) ってことです。

大抵の本意載っているやり方。

$tabstop = 8;
$_ = "xxx\txxx\t\txx";
1 while s/([^\t]*)(\t+)/$1 . (" " x (($tabstop * length($2)) - (length($1) % $tabstop)))/e;

もちろん、これ以外のを考えろってことか・・・へたれの俺には難しい。

>>7
http://yasu.asuka.net/diary/200103B.html#i20010318H
の
http://www6.plala.or.jp/private-hp/samuraidamasii/kikaku/kahou/kahou7.htm
に悶え苦しんだ(藁

こんなのを考えるだけでもかなり時間がかかる・・・まだまだ。

$TABSTOP = 8;
$data = "1xx\t2xxxxx\t\t3xxxx\t4x\t\t\t5xxxxxxx\t6xx";
@d = split(/\t/＠｀ $data＠｀ -1);
$d = pop(@data);
$data = join ''＠｀ (map {$_ . '_' x ($TABSTOP - length($_) % $TABSTOP)} @d)＠｀ $d;

う、最後の行は
$data = join ''＠｀ (map {$_ . ' ' x ($TABSTOP - length($_) % $TABSTOP)} @d)＠｀ $d;
だ。鬱。

s/\t/ ' 'x($tabstop-length($`)%$tabstop) /e while /\t/;

s///egでいければスマートだったんだけどなぁ・・・

1 while s/\t/ ' 'x($tabstop-length($`)%$tabstop) /e;
か、くそ・・

s///eg 使う方法で、最も単純なのは
s/\t/" " x (8 - length($`) % 8)/eg;
だね。($` 使うので全体として速度が低下するけど。)

>>13
それでは出来ません。
s/\t/ print($`); ' ' /eg ;
と
s/\t/ print($`); ' 'x$i++ /eg ;
を比べてみればわかります。

$` を使うと速度が低下するとは始めて知ったんですが、
どこかに情報がありますか？

俺の読んでる本には書いてるな。

s/\t/ print($`); ' 'x$i++ /eg ; >>14
使っているperlのバージョンは?
以下の環境では問題なく動いたけど。
This is perl＠｀ version 5.005_03 built for i386-freebsd
This is perl＠｀ v5.6.0 built for i386-freebsd
(FreeBSD 4.3-BETA i386)

$` $& $' を使うと速度低下を引き起こすってのは、perldoc -q '\$`'
----
Why does using $&＠｀ $`＠｀ or $' slow my program down?

Because once Perl sees that you need one of these
variables anywhere in the program＠｀ it has to provide them
on each and every pattern match. The same mechanism that
handles these provides for the use of $1＠｀ $2＠｀ etc.＠｀ so you
pay the same price for each regex that contains capturing
parentheses. But if you never use $&＠｀ etc.＠｀ in your
script＠｀ then regexes without capturing parentheses won't
be penalized. So avoid $&＠｀ $'＠｀ and $` if you can＠｀ but if
you can't＠｀ once you've used them at all＠｀ use them at will
because you've already paid the price. Remember that some
algorithms really appreciate them. As of the 5.005
release. the $& variable is no longer "expensive" the way
the other two are.

青駱駝のどこかにもかいてあるはず。

perldoc情報サンクス。

とりあえずテストしたのは、
This is perl＠｀ v5.6.0 built for MSWin32-x86-multi-thread
(ActivePerl618)

青ラクダ日本語 改訂版 P74注釈
s/pattern/length($`)/egのように、パターンのマッチと置換が
何回も行われるケースでは、それまでに行われた置換の結果は
$`に反映されない。
かわりに、
1 while s///e;
使えと。
っていうか、ここに答えも載ってるな・・・

s/\t/print($`);"\t"/eg;
と
s/\t/print($`);" "/eg;
の方が適切っすね。
この二つの出力が同じになりますよね。
多分、g修飾子使うと内部で study と同じような事してる
んじゃないのかな？（根拠なし）

あ、たしかにうまく動きません。(よく考えればそうだよな、と納得。)
失礼しました。

暇につき、お題を考えました。

┏━┯━┯━┯━┓　　　有名な15パズルですね。
┃05│15│01│04┃　　　これを最短で解く手順を出力してください。
┠─┼─┼─┼─┨　　　左図では 01-15 のように各セルを命名
┃14│02│06│11┃　　　していますが、命名法は自由です。
┠─┼─┼─┼─┨　　　出力フォーマットも自由ですが、
┃10│03│08│13┃　　　13＠｀11＠｀06＠｀01＠｀・・・とかでいいでしょう。
┠─┼─┼─┼─╋━┓
┃09│07│12│□│16┃
┗━┷━┷━┷━┷━┛

さ、気長にがんばってください。

┏━┯━┯━┯━┓
┃05│15│01│04┃
┠─┼─┼─┼─┨
┃14│02│06│11┃
┠─┼─┼─┼─┨
┃10│03│08│13┃
┠─┼─┼─┼─╋━┓
┃09│07│□│12│16┃
┗━┷━┷━┷━┷━┛

>>20
奇置換に見えるけど、おいらの数え間違い?

奇置換 ってなんですか？アルゴリズムの一種？
無知な俺に教えてください。

偶巡回置換を数えると、、
(5＠｀14＠｀7＠｀6＠｀2＠｀15＠｀12＠｀13＠｀9＠｀10＠｀3＠｀1)(4)(11＠｀8)
ということで、偶巡回置換は2なのでいけるはず
つか、板違いの方向へ？ 故にsage

http://green.nttec.com/tech/read.cgi?KEY=985620558
なにも考えずに横型探索したら
13ステップで局面が15500通りに。そこで止めた。
ちからまかせじゃ無理ですか。

>>24
そか、(11 8)を見落とした。鬱氏。

>>23
ぐんろんなのかなあ。例えばここを見よ。
http://www.pro.or.jp/~fuji/pasocomlife/1996-08-12.html

15パズルを解くスクリプトができたよー
http://green.nttec.com/tech/read.cgi?KEY=985886118
>>20 のやつは58手で解けた。
ただし枝刈りが強引なので最短手順とはかぎらない。
つーかきっと最短じゃない。

http://green.jbbs.net/tech/read.cgi?KEY=985886118
これって何？

せっかくだから、こんな問題を出してみる。

現在の年月日から数えて最も近い「13日の金曜日」を求めるスクリプトを書け。

ベタにlocaltimeとtimelocalを使ったヤツを書いたら妙に長くなったからヤメ。
公式使ったヤツで書いた方が楽だね。

13日の金曜日の最大間隔は427日(たぶん)なので
たかだか426回のループ回すだけで答がでる。というヘタレ解答。

$t=time;
$t+=24*60*60 while join('='＠｀(localtime($t))[3＠｀6]) ne '13=5';
print scalar(localtime($t))＠｀"\n";

弱い者の味方、月光仮面おじさん登場!!!
ホームページを作ったものの、まったくアクセスが上がらな
くて悩んでいる人のためにお役に立ちましょう。
効率よく宣伝できる共有宣伝掲示板を18個設置しました。
全部宣伝して回ればなんと1＠｀000以上の掲示板にカキコしたこ
とになり即、効果が期待できます。さらに共有掲示板の隠し
リンクを発見してそれらも全部宣伝して回ると計2＠｀000以上の
掲示板にカキコしたことになり、さらにアクセスアップを期
待できます。もう、今日からアクセスが無くて悩むことは無
いです。今すぐここからアタックアタック!!

http://home9.highway.ne.jp/cym10262/

>>31
なんで427日？
（煽りじゃなくて純粋にわからない）

じゃあ、次のお題は13日の金曜日の最大間隔を求めるスクリプトを
書きなさいってことでいい？

で、どうなのよ？age

>>33
いや単に1970年から100年間、13日の金曜をリストアップしただけっす。
やっぱ2800年間のリスト作んないとだめかね。

あ、これ書いて思い出したけど2038年問題ってのがあるんだっけか。
2038年以降の時刻にlocaltimeは使えないとかなんとか。
>>31の「427」は大嘘だったかもー。

新しいお題を出しても良いデスカー？

-------------------------------------------
問題：「キリ番撲滅カウンタを作れ」

関数countupとして使える形にしてください。
通常は以下のように呼び出すと、$newcount == $count+1になる。
　　$count = 123;
　　$newcount = &countup($count);

ただし結果が100だの123だの、いわゆる「キリ番」になる場合は、
キリ番じゃなくなるまで+1しつづける。絶対にキリ番を出さない。

＃なにが「キリ番」かという判定は、回答者の判断におまかせします。

１〜１００００までのキリ番をリストアップ！

1 11 22 33 44 55 66 77 88 99 100 111 123 150 200 222 234
250 300 333 345 400 444 456 500 555 567 600 666 678 700
777 789 800 888 890 900 999 1000 1100 1111…

キリないからやめた（藁

sub countup{
　　my $count = $_[0];
　　my @c = split(//＠｀ $count);
　　while(1){
　　　　my $flag1 = 0;
　　　　foreach (1..$#c){ # 階段状 ex.2345
　　　　　　if($c[$_-1] +1 != $c[$_} ){
　　　　　　　　$flag1 = 1;
　　　　　　　　last;
　　　　　　}
　　　　}
　　　　my $flag2 = 0;
　　　　foreach (1..$#c){ # 同列 ex. 666
　　　　　　if($c[$_-1] != $c[$_} ){
　　　　　　　　$flag2 = 1;
　　　　　　　　last;
　　　　　　}
　　　　}
　　　　if( ($count % 100) && $flag1 && $flag2 ){
　　　　　　last;
　　　　}
　　　　$count++;
　　}
}

あ、
my @c = split(//＠｀ $count);
はwhile の中だった。
ゲソーリ

>>34
もっとうまいやり方あるだろうけど思うけど、いちお回答。
結局、427日になりましたとさ。

my @days_of_mon = (
[31＠｀28＠｀31＠｀30＠｀31＠｀30＠｀31＠｀31＠｀30＠｀31＠｀30＠｀31]＠｀
[31＠｀28＠｀31＠｀30＠｀31＠｀30＠｀31＠｀31＠｀30＠｀31＠｀30＠｀31]＠｀
[31＠｀28＠｀31＠｀30＠｀31＠｀30＠｀31＠｀31＠｀30＠｀31＠｀30＠｀31]＠｀
[31＠｀29＠｀31＠｀30＠｀31＠｀30＠｀31＠｀31＠｀30＠｀31＠｀30＠｀31] );

my $dmax = 0;

foreach $year (0..3) {
foreach $month (0..11) {

my ($day＠｀$dday) = (19＠｀7);

until ($day == 12)
{
$dday += 7;
$day += 7;

if ($day >= $days_of_mon[$year][$month]) {
$day %= $days_of_mon[$year][$month];
$month++;
}
$month %= 12 or $year++;
$year %= 4;

}

$dmax = $dmax > $dday ? $dmax : $dday;

}
}
print "result:$dmax\n";

>>37
自分が欲しいから作ってもらおうってのがミエミエだよ。

>>42
それがなにか？

>>43
それじゃ学校の課題と大差ないからやめれってことだよ。
答えた俺も俺だが。

>>42
こんなもん欲しがるやつがいるのか(笑

>>39
バカは気に寸な。どうせ人気ないスレなんだからﾏﾀｰﾘやってこうよ。

>>37=45
いや〜、いるでしょ。
http://mentai.2ch.net/test/read.cgi?bbs=hp&key=980646455
http://mentai.2ch.net/hp/kako/971/971149794.html
ここの人たちとか。
っていうか、Quiz/Puzzleなんだから、
具体的な用途がある出題は好まれないと思ふ。
ツクッテ君が来たらやだ。

>>46
＞ツクッテ君が来たらやだ。
あ〜、そりゃそうか。了解。次から気をつけます。
すくなくとも「出題者は必ずｎ日以内に自分の答も出す」ぐらいの
縛りはつけるか。あと各解答へのコメントもできればつける。
おれも来週の金曜か土曜には>>37のまとめを書くよ。

>>37
如何か。

sub countup {
  my $count=1+shift;
  $count++ while (
  $count % 100 == 0 #キリ番 100の倍数
  or $count =~/^(\d)\1+$/ #ぞろ目
  or $count > 100 and index("1234567890"＠｀ $count)>=0 #のぼり賞
  or $count > 100 and index("0987654321"＠｀ $count)>=0 #くだり賞
  );
  $count;
}

このスレもWEBプログラミング板に移住します。
あいかわらずPerl限定でいいですよね。

>>48
うあ、レスがあることにぜんぜん気が付なかった。
まとめ作成さぼっててすんません。しばし待ってくれ。

新スレはこちら
http://corn.2ch.net/test/read.cgi?bbs=php&key=988798260