サブルーチンの結果

質問

my @data; my ($rows,$cols);
sub Gettest {
use Text::ParseWords;
my $dfile = shift; # CSVファイル
my @array = @_;　@data = ();
open(IN, $dfile) or exit(-1);#
while(<IN>) { chomp;
my @fields = quotewords("," => 0 , $_); # カンマデータの取込
foreach my $field (@fields){
if(index($field, ":") >= 0) {
my @range = split(':',$field);# 範囲の取出し
$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};
} elsif(index($field, ",") >= 0) {
my @list = split(',',$field); #種類の取出し
$field = sub { my $v = shift; return grep($v == $_, @list); };}}
push @data, [@fields];}
close(IN);
$rows = @data; $cols = @{$data[0]};
return squeezed(@array);#// 該当範囲の絞り込み}
sub squeezed {
my @para = @_;　my @pos = (0 .. ($cols -1));
my $i; my @wk;
for($i = 0; $i < $rows -1; $i++) {
@wk = ();
foreach my $p (@pos) {# 有効な位置
my $test = $data[$i]->[$p];
if("CODE" eq ref($test)){ # 範囲テストコードの場合
push @wk, $p if &$test($para[$i]); # test がＯＫ
} elsif($para[$i] eq /$test/) {push @wk, $p; # マッチ位置を配列に}}
@pos = @wk;}
if(@pos == 1){ return $data[-1]->[$pos[0]];
} else {return undef;#// 該当なしか2個以上ならundefを返却
}}1;
引数によってCSVデータの範囲を絞って結果を返すといった関数を、ご提供して頂いた
のですが、「1:4」や「1,3,4」等の答えがCODE(XXX)になってしまいます。ご提供者様から、ループで変換するのではなく
最終行のみ変更を加えないようにするというアドバイスを頂いて色々ためしてみたのですが、
私のレベルではサブルーチンの理解が出来なくて全然うまくいきません。他力本願な
お願いで申し訳ないのですが、解る方教えて下さい。

回答No.6

BLUEPIXY · ベストアンサー

#5>そんなに違うものなんですか？？？
[ quotewords("," => 0, $lines[@lines-1]) ]
は、１行分のデータの無名配列です。
なので、これをpush していくと
$data[0]=[１行目のデータ];
$data[1]=[２行目のデータ];
…
となります。
quotewords("," => 0, $lines[@lines-1])
は、配列なので、
push @data, 配列 とすると、
$data[0]= １個目のフィールド;
$data[1]= ２個目のフィールド;
…
というようになり、
@data には、各行のデータを入れたいのに、各列のデータが入ってしまいます。

＃５＞「1:3」や「7:12」とかのデータを「1,2,3」や「7,8,9,10,11,12」などに変換するやり方
既にやってるように、
1:3 から
$v1 = 1;
$v2 = 3;
の様に取り出せたら
@array = ($v1 .. $v2);
のようにすれば 1,2,3 の配列になります。
"1,2,3"の文字列が必要ならさらに
$atext = join(',', @array);
とすればいいです。

お礼

BLUEPIXY様
私の他力本願なお願いに最後まで付き合ってくれて、ありがとう
ございました。

なるほど…レコードを扱わなければいけないのに、フィールドを
Pushしてたんですね。

＞「1:3」や「7:12」とかのデータを「1,2,3」や「7,8,9,10,11,12」
これも扱っていましたね^^;

丁寧に説明してくださって、とっても解りやすかったです^^
ありがとうございました。

回答No.5

BLUEPIXY

#4を修正してみました。
my @data;
my $rows;
my $cols;

#sub Gettest {
use Text::ParseWords;
my $dfile = shift; # CSVファイル
#my @array = @ARGV;

@data = (); # 配列の初期化(読み込んだデータの格納用)

open(IN, $dfile) or exit(-1);# データファイルの読込み
#while(<IN>) {
#chomp;
@lines = <IN>;
chomp @lines;

foreach (@lines[0..(@lines-2)]){
my @fields = quotewords("," => 0 , $_); # カンマ区切りデータの取り込み
foreach my $field (@fields){
if(index($field, ":") >= 0) {
my @range = split(':',$field);# 範囲の取り出し
$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};
} elsif(index($field, ",") >= 0) {
my @list = split(',',$field); #種類の取り出し
$field = sub { my $v = shift; return grep($v == $_, @list); };
}
}
push @data, [@fields];
}
close(IN);

push @data, [ quotewords("," => 0, $lines[@lines-1]) ];

$rows = @data;
$cols = @{$data[0]};
#return squeezed(@array);#// 該当範囲の絞り込み
$val = squeezed(@ARGV);#// 該当範囲の絞り込み
print $val;
#}

sub squeezed {
my @para = @_;
my @pos = (0 .. ($cols -1));
my $i;
my @wk;
for($i = 0; $i < $rows -1; $i++) {
@wk = ();
foreach my $p (@pos) {# 有効な位置だけ調べる
my $test = $data[$i]->[$p];
if("CODE" eq ref($test)){ # 範囲テストコードの場合
push @wk, $p if &$test($para[$i]); # test がＯＫ
} elsif($para[$i] eq $test) {
push @wk, $p; # マッチした位置を配列に保存
}
}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {
return undef;#// 結果が該当なし、もしくは2個以上ならundefを返却
}
}
#1;
----------------------------------------------------------------
あと、test1.csv も test2.csv も最終行の前までに値が１つに決まりません。
（３行目が1:12 の為に全てがそれまでの該当し、４行目の時点で２つ該当するモノがあるため）

補足

BLUEPIXY様
長い間、ありがとうございました。
本当に、本当に助かりました^^
そして、使えないテストデータを送ってしまって
申し訳ありません。。。。

ところで、
push @data, [ quotewords("," => 0, $lines[@lines-1]) ];
と
@aaa = quotewords("," => 0 ,@lines[@lines-1]);
push @data, @aaa;
は、そんなに違うものなんですか？？？

あ、あと「1:3」や「7:12」とかのデータを
「1,2,3」や「7,8,9,10,11,12」などに変換するやり方
はありますか？？

回答No.4

BLUEPIXY

#3>上記の処理フロー自体が間違っているのでしょうか？？？
変更した、プログラム、
テストに使用したデータ、パラメータ
を補足していただけますか？

補足

<プログラム>
$aaa = @ARGV[1];
$bbb = @ARGV[2];
$ccc = @ARGV[3];
$ddd = @ARGV[4];
$eee = @ARGV[5];
$fff = @ARGV[6];
$ggg = @ARGV[7];

my @data;
my $rows;
my $cols;

#sub Gettest {
use Text::ParseWords;
my $dfile = shift; # CSVファイル
my @array = ($aaa,$bbb,$ccc,$ddd,$fff,$ggg);

@data = (); # 配列の初期化(読み込んだデータの格納用)

open(IN, $dfile) or exit(-1);# データファイルの読込み
#while(<IN>) {
#chomp;
@lines = <IN>;
chomp @lines;

foreach (@lines[0..(@lines-2)]){
my @fields = quotewords("," => 0 , $_); # カンマ区切りデータの取り込み
foreach my $field (@fields){

if(index($field, ":") >= 0) {
my @range = split(':',$field);# 範囲の取り出し
$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};
} elsif(index($field, ",") >= 0) {
my @list = split(',',$field); #種類の取り出し
$field = sub { my $v = shift; return grep($v == $_, @list); };
}
}
push @data, [@fields];
}
close(IN);

@aaa = quotewords("," => 0 ,@lines[@lines-1]);

push @data, @aaa;

$rows = @data;
$cols = @{$data[0]};
#return squeezed(@array);#// 該当範囲の絞り込み
$val = squeezed(@array);#// 該当範囲の絞り込み
print $val;
#}

sub squeezed {
my @para = @_;
my @pos = (0 .. ($cols -1));
my $i;
my @wk;
for($i = 0; $i < $rows -1; $i++) {
@wk = ();
foreach my $p (@pos) {# 有効な位置だけ調べる
my $test = $data[$i]->[$p];
if("CODE" eq ref($test)){ # 範囲テストコードの場合
push @wk, $p if &$test($para[$i]); # test がＯＫ
} elsif($para[$i] =~ /$test/) {
push @wk, $p; # マッチした位置を配列に保存
}
}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {
return undef;#// 結果が該当なし、もしくは2個以上ならundefを返却
}
}
#1;

<test1.csv>
1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4
1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4
1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12
1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4,1:2,3:4
<test2.csv>
1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4
1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4,1,1,2,2,3,3,4,4
1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12,1:12
"1,4","5,9","1,4","5,9","1,4","5,9","1,4","1,4","1,4","5,9","1,4","5,9","1,4","5,9","1,4","1,4","1,4","5,9","1,4","5,9","1,4","5,9","1,4","1,4","1,4","5,9","1,4","5,9","1,4","5,9","1,4","1,4"

どのパラメータでも、答えが返ってきません。。
宜しくお願い致しますm(__)m

回答No.3

BLUEPIXY

#2>やはりうまくいきません。。。。
実際に動かして試してはいないんですけど・
while(<IN>) {
chomp;
の部分を
@lines = <IN>;
chomp @lines;
foreach(@lines){
my @fields = quotewords("," => 0 , $_);
}
に置き換えたわけですよね。
この場合、最後の } が要りませんね。
while での<IN> が
foreach での @lines に変わったわけですので
あと、
foreach(@lines){
だと、全部の行を処理することになるので、ここで最終行を除くループにする必要があります。
foreach my $field (@fields[0..(@fields -2)]){
の@fields は、一行のデータをカンマでフィールドに分けた配列のことですから見当違いです。
基本的に元のプログラムで、
while(<IN>) の入力が $_ になっている部分が
foreach(@lines) で $_ になっていれば
その最終行の処理の変更以外は、元のプログラムを変更する必要はありません。
まずは、元のプログラムと同じ流れになるように変更して、
最終行の場合どこで変更すればいいかを考えるといいと思います。

補足

BLUEPIXY様、アドバイスありがとうございます。

何度も聞いてしまって申し訳ないのですが、また
質問させてください。

@lines[@lines-1]が最終行になるわけですよね？

@lines[0..(@lines-2)]に対して、ループ処理をしたあと
列数($cols)と行数($rows)を取得する前に
最終行にquotewordsとchompを処理して新たな配列を作成し
@dataにpushしたのですが、答えが戻ってきません。
(「:」や「,」を使っていないデータも含め)

エラーコードが返ってくるわけではないのですが、、、

上記の処理フロー自体が間違っているのでしょうか？？？

回答No.2

BLUEPIXY

>読込ループで変換するのではなく最終行のみ変更を加えないようにする
簡略化して書くと、ファイルを読込ながらする処理は、
例えば、
open(IN, "読込ファイル");
while(<IN>){
#$_ に対する処理
}
close(IN);
の様になります。
ファイルからの読込時に処理するのではなくて、
いったん全部読み込んでから処理する場合、
open(IN, "読込ファイル");
my @lines=<IN>; #配列に全部読み込む
close(IN);
foreach (@lines){
#$_ に対する処理
}
とすれば同じになります。
ここで、最終行を除く場合は、
例えば
foreach (@lines[0..(@lines-2)]){
#$_ に対する処理
}
のようにすればいいです。
（質問のプログラムの場合、chomp と quotewords の処理は、最終行にも行う必要があります）
もしくは、
my $len = @lines ;
で読み込んだファイルの行数がわかるので、
$_ の代わりに $lines[$n]のようにして、for 文で、まわして
$n が$len -1 （最終行）でないかどうか調べて、処理を分けるようにすればいいでしょう。

補足

BLUEPIXY様、ご回答ありがとうございます。

何度もお手数かけて本当に申し訳ないのですが、やはりうまくいきません。。。。
下記のようにしてみたのですが、結果が戻ってきません。
なにがいけないのでしょうか？？

そしてスクリプト上で何をやっているのか書いてみました。
わからないとこも多々あり、意味がおかしいとこも指摘してくださると助かります。

$aaa = @ARGV[1];
$bbb = @ARGV[2];
$ccc = @ARGV[3];
$ddd = @ARGV[4];
$eee = @ARGV[5];
$fff = @ARGV[6];

my @data;
my $rows;
my $cols;

#sub Gettest {
use Text::ParseWords;

my $dfile = shift;
my @array = ($aaa,$bbb,$ccc,$ddd,$eee,$fff);

@data = ();
open(IN, $dfile) or exit(-1);#(1)ファイルの読み込み

#while(<IN>) {
#chomp;
@lines = <IN>;#(2)読み込んだファイルを配列へ
chomp @lines;#(3)行末の改行削除

foreach(@lines){#(4)@lineのデータを$_に順番に入れる
my @fields = quotewords("," => 0 , $_);#(5)$_のデータのカンマ区切りを配列へ
}
foreach my $field (@fields[0..(@fields -2)]){#(6)配列の最終行以外を$filedへ順番に入れる
if(index($field, ":") >= 0) {#(7)":"が0個以上あれば
my @range = split(':',$field);#(8)配列に":"を区切りにして格納
$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};#(9)$range[0]～[1]の範囲を求める
} elsif(index($field, ",") >= 0) {
my @list = split(',',$field);#(10)","が0個以上あれば
$field = sub { my $v = shift; return grep($v == $_, @list); };#(11)配列から$vを検索
}

push @data, [@fields];#(12)配列(リスト)を配列の末尾へ
}
close(IN);
$rows = @data;#(13)要素数を求める
$cols = @{$data[0]};#(14)列の長さ、、、リファレンス？？？
$val = squeezed(@array);#// 該当範囲の絞り込み

print $val;
#}

sub squeezed {
my @para = @_;
my @pos = (0 .. ($cols -1));#(15)列のサイズを配列へ
my $i;
my @wk;
for($i = 0; $i < $rows -1; $i++) {#(16)行数分カウントアップしながらループ
@wk = ();
foreach my $p (@pos) {# (17)有効な位置だけ調べる(？？？)
my $test = $data[$i]->[$p];
if("CODE" eq ref($test)){ #(18)変数がサブルーチンの戻り値以外なら(？？？)
push @wk, $p if &$test($para[$i]); #(19)？？？
} elsif($para[$i] eq /$test/) {#(20)変数(配列)が$test以外なら？？
push @wk, $p; # マッチした位置を配列に保存
}
}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {
return undef;#// 結果が該当なし、もしくは2個以上ならundefを返却
}
}
#1;

回答No.1

osamuy

てっとりばやく最終行を1行めにもってきて、
$_ = <IN>; chomp; my @answer = quotewords("," => 0 , $_); # 回答行を取得。残りの行を@dataに。
while ( <IN> ){ chomp; # 以下略。

として、

return $#pos == 0 ? $answer[ $pos[0] ] : undef;

――みたいにするとか。

補足

osamuy様、
アドバイスありがとうございます。
早速、試してみたのですが「1:4」「1,3,4」以外の普通の答え(英数字)も返ってこないみたいです…

私自身でも最初にファイルを読み込んで、popして最後にpushして…みたいなことを
色々試しているのですが、リファレンスの概要をきちんと理解していないため、サブルーチンの中の
サブルーチンの動きが全然わかりません。。。

とても困っているので、解るようでしたら是非ご教授願えないでしょうか？？？