教えてください

質問

何度もこちらでお世話になっております。どうしてうまくいかないのか、教えて下さい。
下記csvファイルは問題ないのですが、それ以外を引数に与えると結果が表示されません。

概要：アンケート　
≪test.html≫　※設問ファイル
質問1～5(3択)まである

≪test.cgi≫　※結果表示
&ReadParseを使用
@pairs = ($in{'q1'},$in{'q2'},$in{'q3'},$in{'q4'},$in{'q5'});
$values = Gettest("data1.csv",@pairs);
print $values,"\n";

≪test.pl≫　※サブルーチン
sub Gettest {
use Text::ParseWords; 　#// 標準モジュール
my @array = @_;
my $dfile = shift @array;　#// CSVファイル
@data = ();　#// 配列の初期化(読み込んだデータの格納用)
open(IN, "$dfile") or exit;　#// データファイルの読込み
while(<IN>) {
chomp;
@fields = quotewords("," => 0 , $_); #// カンマ区切りデータの取り込み
foreach $field (@fields){
if(index($field, ":") >= 0) {
$field =~ s/:/-/;　#// データの整形(1:3→[1-3])
$field = "[$field]";
} elsif(index($field, ",") >= 0) {
$field =~ s/,/\|/g;#// データの整形(1,3,4→1|3|4)
}}
push @data, [@fields];
}
close(IN);
$rows = @data;
$cols = @{$data[0]};
$values = squeezed(@array);#// 該当範囲の絞り込み
return "$values\n";
exit;
sub squeezed {
my @para = @_;
my @pos = (0 .. ($cols -1));
my $i, @wk;
for($i = 0; $i < $rows -1; $i++) {
@wk = ();
foreach my $p (@pos) {#// 有効な位置だけ調べる
if($para[$i] =~ /$data[$i]->[$p]/) {
push @wk, $p; #// パターンマッチする位置を配列に保存
}}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {return exit;#// 結果が該当なし、もしくは2個以上ならエラーを返却
}}}
1;

回答No.7

BLUEPIXY · ベストアンサー

#6＞my @range = split(':',$field);# 範囲の取り出し
#6＞$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};
$field="n:m" のようなパターンの場合、
my @range = split(':',$field); で
$range[0] = n , $range[1] = m のように n, m を切り出せます。
"n:m" の場合、あとから調べる値がｎ～ｍ の範囲にあるかを調べたいワケですが、もし、 ｎ～ｍ の範囲にあるかどうかを調べる関数をつくるとすると
sub rangeTest {
my $v = shift;
return n <= $v && $v <= m;
}
のような形になると思います。
n=2,m=7 の時
if(&rangeTest(5))
とかすれば、５が２と７の範囲にあって条件が真になるワケです。
このようなチェックは squeezed 関数のなかでやってもいいのですが、
ＣＳＶデータを読み込んだ時に、あるフィールドのｎ：ｍは、決まっているので、繰り返し squeezed 関数を使う場合には、ｎ：ｍをその度にsqueezed 関数で切り出すのは、ムダっぽいですね。
できれば、データを読み込む段階で同じ処理は済ませておきたいワケです。
それで、
my @range = split(':',$field);# 範囲の取り出し
$field = sub { my $v = shift; return $range[0] <= $v && $v <= $range[1];};
の様にしています。
$変数 = sub { … };
のようにして名前のない関数を変数に割り当て変数から呼び出すことができます。
&$変数(…)　のように呼び出します。
$field には、そのフィールドで指定されていた範囲を調べる関数を割り当てているので、後で、使う場合には、単に値を与えてテスト（呼び出し）すれば良いわけです。

#6>my @list = split(',',$field); #種類の取り出し
#6>$field = sub { my $v = shift; return grep($v == $_, @list); };
同様に
"x,y,z" のパターンの場合は、あとで調べる値が、カンマで区切られたどれかに一致するということを調べたいワケです。
my @list = split(',',$field)
で
@list = (x, y, z) のような形で切り出すことができます。
grep($v == $_, @list);
は、$v に一致する要素を配列の形で抜き出します。
例えば、$v = y の場合
( y ) になることになります。（一致が複数ある場合は(y , y …)）
また、一致が無い場合は、( ) になります。
この値を
if( … )　で調べると、
( ) の場合偽になり、そうでない場合は、真になりますので、
指定した値が含まれていたかどうか調べることができます。

>if("CODE" eq ref($test)){ # 範囲テストコードの場合
前述したように、$fileld には、関数が割り当てられている場合と、
単に普通の値が代入されている場合があります。
ref $変数 のようにすることで、$変数に割り当てられているものが何か調べることができます。
関数が割り当てられている場合、'CODE' が返されるので、
ここでは、関数かどうか調べて、関数が割り当てられていれば
&$test($para[$i]) の様に呼び出します。

#6>push @wk, $p if &$test($para[$i]); # test がＯＫ
命令文 if 条件;
のように記述した場合、条件が成立した場合命令文を実行します。
この場合、$para[$i] で値を渡して、調べて条件が成立していれば、$p （その時の位置）を 配列 @wk に追加する
ということになります。

#6>} elsif($para[$i] =~ /$test/) {
は、
$para[$i] が　指定したパターン　$test （の中味)に一致するかどうかを調べています。
今回、"n:m" と "x,y" の処理を変えたので、elsif で残っているのは、１つの値のみなので、
単純に
} elsif($para[$i] eq $test) {
としても良いところです。
というか、
} elsif($para[$i] eq $test) {
に"して下さい"（修正を忘れてました！！！）

#6>$data[$i]->[$p]; で、有効範囲が入るんですよね？
今回の修正で、
指定した値か、指定した値に該当するか調べる関数（への参照）が入るということになります。
＞push @data, [@fields];
の様にデータを作成しているので
値を取り出す時に、$data[$i]->[$p] の様に取り出すことになります。
普通、配列というと
( d1, d2, d3) のようになっていますが
( (d11, d12, d13), (d21, d22, d23)) の様に配列を中味とする配列（配列の配列）を作ることができます。
ただ、前にも説明したと思いますが
@data = ( (d11, d12, d13), (d21, d22, d23)) ;
とすると、
@data = ( d11, d12, d13, d21, d22, d23) ;
となってしまいます。
そのような場合
@data = ( [d11, d12, d13], [d21, d22, d23]) ;
とします。
[ ] は、無名の配列を作ってくれます。
名前のある配列の配列を作る場合には、
@d1=(d11, d12, d13);
@d2=(d21, d22, d23);
の時
@data = ( \@d1, \@d2) ;
のようにします。
ココで\ は、配列の場所を表す"参照"を取り出します。
つまり
@data = (参照１, 参照２);
のようになるというわけです。
同じように
@data = ( [d11, d12, d13], [d21, d22, d23]) ;
の場合も参照が配列@data の要素となります。
このように配列の中味が配列への参照である時には
$data[x]->[y] のように取り出します
($data[x][y] でもＯＫ)

お礼

BLUEPIXY様、
丁寧且つ解りやすい解説、ありがとうございます。
まだ理解しきっていない部分もありますが、色々試しながら砕いていきたいと思います。

度重なる質問と、お返事に時間がかかってしまい、気を悪くなさったかもしれませんが
とても感謝してます。ありがとうございました！
ポイント20じゃ、足りないくらい…(^^;

またお世話になるかもしれませんが、その時は
宜しくお願い致しますｗ

回答No.6

BLUEPIXY

#修正しました
my @data;
my $rows;
my $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] =~ /$test/) {
push @wk, $p; # マッチした位置を配列に保存
}
}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {
return undef;#// 結果が該当なし、もしくは2個以上ならundefを返却
}
}
1;

補足

BLUEPIXY様、返事が遅れました。
ゴメンナサイ。。。
体調を崩してたのもあったのですが、ネットワークの調子が悪くて接続が出来ませんでした…
本当に、スミマセン(ToT)

色々な想定で、組んで下さったのですね。感謝感激です！
ありがとうございます。
ところで、やはり解説を頂きたいのですが

>$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); };
の部分と、
>if("CODE" eq ref($test)){ # 範囲テストコードの場合
>push @wk, $p if &$test($para[$i]); # test がＯＫ
>} elsif($para[$i] =~ /$test/) {
をお願いします。

それと、以前からある部分なんですが、
>$data[$i]->[$p];
で、有効範囲が入るんですよね？この部分の動きも、私が勉強不足なだけなのですが
いまいちピンときません。。
いつも、お世話になりっぱなしで申し訳ありませんが、教えていただけないでしょうか？

回答No.5

BLUEPIXY

#4は、a:b の場合を修正しただけで
"a,b,c" とかの場合の二桁の場合を考えていませんでした。
修正しますので、しばしお待ちを・

回答No.4

BLUEPIXY

修正してみました。
<<メイン>>
require "test.pl";

@pairs = (1,2,9,3,2);
$values = Gettest("data2.csv", @pairs);
print "$values\n" if defined($values);

<<サブ：test.pl>>
my @data;
my $rows;
my $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) {
$field =~ s/,/\|/g;#// データの整形(1,3,4→1|3|4)
}
}
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]); # 範囲内なら保存
} elsif($para[$i] =~ /$data[$i]->[$p]/) {
push @wk, $p; # マッチした位置を配列に保存
}
}
@pos = @wk;
}
if(@pos == 1){ #// 結果算出
return $data[-1]->[$pos[0]];
} else {
return undef;#// 結果が該当なし、もしくは2個以上ならundefを返却
}
}
1;

回答No.3

BLUEPIXY

＃２補足＞8:12
なるほど、２桁の数字は想定外でした。
なので、元のプログラムではうまく動きません。
ちょっと考えてみます・・

回答No.2

BLUEPIXY

data2.csv を補足していただけますか？

補足

BLUEPIXY様、補足要求ありがとうございます。

＜data2.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:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12,1:7,8:12
3,3,3,3,1,1,1,1,3,3,3,3,1,1,1,1,4,4,4,4,2,2,2,2,4,4,4,4,2,2,2,2
1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2
a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,aa,bb,cc,dd,ee,ff

こんな感じの内容です。
自分でいろいろ試してみたのですが、「8:12」の「8:1」の部分で引っかかっている
ように見えます。

「8:12」→「8-12」で試したら、「12」の値でエラーになってしまいました。
私には、サッパリわかりません…
ご教授下さい、お願いしますｍ(__)ｍ

回答No.1

BLUEPIXY

>下記csvファイルは問題ないのですが、それ以外を引数に与えると結果が表示されません。
問題ないのと問題あるのと、その時の引数を教えてください。

お礼

問題ない場合を書いていなかったですね。。。
data1.csvで与える引数は、すべて大丈夫です。
なので逆に、別のcsvファイル(data2.csv等)の場合にうまく表示されないのが、何故なのか…困っています。

補足

BLUEPIXY様、
早々の回答とても感謝致します。いつもすみません。
data2.csvで与えた引数は、「1,2,1」です。実際は、htmlからの設問が固定であります
ので、「1,2,1,1,1」になりますが、結果を得たあとの引数は、多い分には問題なかった
と思います。(perlコマンドでの実行時ではですが…)