次のような1行1用語が並んだファイルから、「スペースで区切られたカタカナ」を抽出する方法を考えてください。次に例を示します。
<ファイルの例>
インターネット Web サイト<改行>
ソーシャル ネットーワーキング サイト<改行>
ソーシャル Q&A サイト<改行>
トイザらス ギフト キャンペーン<改行>
</ファイルの例>
<抽出結果>
ソーシャル ネットワーキング サイト
ソーシャル ネットワーキング
ネットワーキング サイト
ス ギフト キャンペーン
ス ギフト
ギフト キャンペーン
</抽出結果>
文字で説明すると長くなりますが、上の例と結果を見るとどんな動きがほしいのか分かってもらえると思います。抽出結果はできれば別ファイルに出力できればモア ベターです。
質問などはコメントにお願いします。
環境
Windows XP Home (推奨)
Windows 7 Pro
Mac OS X Snow Leopard
実現するツールなど:
・ レジストリを書き換えないフリーソフト
・ MS Word 2003/2007 (VBA 可)
・ MS Excel 2007 (VBA 可)
・ 秀丸、TeraPad、その他エディター
・ PHP 5.3 (ローカルに環境があります)
・ Perl はできれば避けたい
質問はコメント欄にどうぞ
No.3
3454
969
550pt
vbsです。ファイルをドロップしてください。
同じ場所にResult.txtを作ります。
正規表現でスマートに出来なかったので最長一致で抜き出して分割という泥臭いことをしています。
Option Explicit On Error Resume Next Dim objFSO Dim objFile,objFile2 Dim fullName,fileName,foldName Dim objRegExp Dim objMatches Dim objMatch Dim strMessage Dim str fullName=WScript.ScriptFullName fileName=Wscript.ScriptName foldName=left(fullName,len(fullName)-len(fileName)) Set objRegExp = New RegExp objRegExp.Pattern = "[ァ-ヶー]+( [ァ-ヶー]+)+" objRegExp.IgnoreCase = True objRegExp.Global = True Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile(WScript.Arguments.Item(0),1) Set objFile2 = objFSO.OpenTextFile(foldName & "\Result.txt",2,True) If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True Set objMatches = objRegExp.Execute(objFile.ReadLine) For Each objMatch In objMatches str = objMatch.Value Do Call test(str) If UBound(Split(str, " ")) >= 2 Then str = Mid(str, InStr(1, str, " ") + 1) Else Exit Do End If Loop Next loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objMatches = Nothing Set objRegExp = Nothing Set objFile2 = Nothing Set objFile = Nothing Set objFSO = Nothing Sub test(s) Dim s1 objFile2.WriteLine s s1 = Left(s, InStrRev(s, " ") - 1) If UBound(Split(s1, " ")) >= 1 Then Call test(s1) End If End Sub
No.1
1422226
秀丸の「検索→置換(Ctr+R)」で以下の設定で全置換を実行。
解説:
カタカナ以外の文字の連続」を半角スペースに置換してます、結果としてスペース区切りのカタカナのだけが残ります。
改行も不要なら [^ァ-ヶー]+ を検索に使えば良いです。
質問文の <ファイルの例> を秀丸にコピペしましたが、質問文の <抽出結果> は得られませんでした。
これは単に、カタカナ以外を半角スペースに変換するだけではないでしょうか。
No.2
1036126
150pt
コメントにて確認をいただきありがとうございました。
与えられた条件に合うようなものをPHPで書いてみました。
この他にも条件があるようでしたらご指摘ください。
<html lang="ja"> <head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> </head> <body> <?php $myself = basename($_SERVER['SCRIPT_NAME']); $infname = isset($_FILES['file']['tmp_name']) ? $_FILES['file']['tmp_name'] : ''; if ($infname == '') { ?> <form method="post" action="<?= $myself ?>" enctype="multipart/form-data"> 元ファイル：<input name="file" type="file" /> <input type="submit" name="submit" value="抽出" /> </form> <?php } else { $dest = array(); $infp = fopen($infname, 'r'); $str = fgets($infp); while (! feof($infp)) { $words = array(); $sour = mb_convert_encoding($str, 'UTF-8', 'auto'); //ここは適当に変更して //スペース区切り以外の部分文字列を除去 $sour = preg_replace("/[ァ-ヶー]*[ ]+[^ァ-ヶー ]+[ ]+/mu", '', $sour); if (preg_match_all("/[ァ-ヶー]+[ \n\r]+/mu", $sour, $words, PREG_PATTERN_ORDER) != 0) { $arr = array(); $n = count($words[0]); //2単語以上で抽出 if ($n >= 2) { $s = ''; for ($i = 0; $i < $n; $i++) $s .= $words[0][$i]; $arr[0] = $s; //3単語以上は組み合わせを作成 if ($n >= 3) { $s = ''; for ($i = 0; $i < $n - 1; $i++) $s .= $words[0][$i]; $arr[1] = $s; $s = ''; for ($i = 1; $i < $n; $i++) $s .= $words[0][$i]; $arr[2] = $s; } $dest = array_merge($dest, $arr); } unset($arr); } unset($words); $str = fgets($infp); } foreach ($dest as $str) echo trim($str) . "<br />\n"; //抽出結果の表示 } ?> </form> </body> </html>
ありがとうございます。
質問文にある元のテキストを使ったところ、質問文の抽出結果とまったく同じものが出力されました。
しかし、カタカナ複合語を 4 ワードにしてみたところ問題発生です。
・ハイパー テキスト マークアップ ランゲージ
上記の用語を入れて抽出にかけてみたところ
・ハイパー テキスト マークアップ ランゲージ
・ハイパー テキスト マークアップ
・テキスト マークアップ ランゲージ
出力結果は上記の通りになりました。
・ハイパー テキスト
・テキスト マークアップ
・マークアップ ランゲージ
上記の 3 つが漏れています。
連続するカタカナ語が 4 ワードを超えることはあまりないのですが、これでは漏れてしまいます。
回答上限を 2 に上げておきました。とりあえず私は本業に戻ります。
かなり泥臭い手法ですが、1 つのスクリプトで全部に対応せず、「2 ワードからなるものだけ」「3おからなるものだけ」のように対象を絞って抽出する方法なら自力でできそうなので、回答が集まらなかった場合は、その方法で対処してみます。
No.3
3454969
ここでベストアンサー
550pt
vbsです。ファイルをドロップしてください。
同じ場所にResult.txtを作ります。
正規表現でスマートに出来なかったので最長一致で抜き出して分割という泥臭いことをしています。
Option Explicit On Error Resume Next Dim objFSO Dim objFile,objFile2 Dim fullName,fileName,foldName Dim objRegExp Dim objMatches Dim objMatch Dim strMessage Dim str fullName=WScript.ScriptFullName fileName=Wscript.ScriptName foldName=left(fullName,len(fullName)-len(fileName)) Set objRegExp = New RegExp objRegExp.Pattern = "[ァ-ヶー]+( [ァ-ヶー]+)+" objRegExp.IgnoreCase = True objRegExp.Global = True Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile(WScript.Arguments.Item(0),1) Set objFile2 = objFSO.OpenTextFile(foldName & "\Result.txt",2,True) If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True Set objMatches = objRegExp.Execute(objFile.ReadLine) For Each objMatch In objMatches str = objMatch.Value Do Call test(str) If UBound(Split(str, " ")) >= 2 Then str = Mid(str, InStr(1, str, " ") + 1) Else Exit Do End If Loop Next loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objMatches = Nothing Set objRegExp = Nothing Set objFile2 = Nothing Set objFile = Nothing Set objFSO = Nothing Sub test(s) Dim s1 objFile2.WriteLine s s1 = Left(s, InStrRev(s, " ") - 1) If UBound(Split(s1, " ")) >= 1 Then Call test(s1) End If End Sub
ばっちりです!
ありがとうございました!
deflation
2010/12/09 14:50:21
214
205
にぎたま
2
1
ばっちりです!
ありがとうございました!