FlyBaseへのリンク
をテンプレートにして作成
開始行:
#contents
*系統の遺伝子型から FlyBase へのリンクを作る perl プログ...
ショウジョウバエ遺伝資源センターでは系統リスト
(http://kyotofly.kit.jp/stocks/)の遺伝子型から
FlyBase へリンクを張っています。
ですが、現在は遺伝子記号(gene symbol)に対してのみしかで...
そこで、もう少し「上手に」リンクを張るために遺伝子型から
リンクを作成するperlのサンプルプログラムを作成しました。
もう少ししたらこれと同じような仕様に変わるでしょう。
実運用に使われるかどうかはわかりません((実装されました))。
ま、とにかく動けばいいのです。
以下の perlスクリプトは、テスト用に html ファイルを stdou...
プログラムはあまり時間を掛けずに書いたので
(一晩でと言いたいところですが、もう少しかかってしまいま...
ボロがあると思います。
今見ると直したい気になるが、ま、いっか((がしかし、今日、...
*** 2015年1月15日追加 [#t2655fdd]
URI unsafe な construct symbol がある場合、
そのままブラウザによる「% encoding」に任せると FlyBase で...
例えば、
P{w[+mW.Scer\FRT.hs3]=3'.RS5+3.3'}
を short construct の形
P{3'.RS5+3.3'}
にしただけではだめ。
これは FlyBase の仕様なのかと思って、
プログラムを直してくれるとうれしいと
FlyBase にコメントを送ったら(本日12時頃)、
速攻で(1時間後くらいに)エスケープが間違っちょる、と返事...
(すごいっ、Josh Goodman さん!)。
そこで、こちらも速攻で perl を作り直しました。
URI query に使う遺伝子記号などの symbol を uri_escape し...
下のスクリプトでは
$temp .= uri_escape($mysymbol);
の部分(もう1行おまじないもあります)。エスケープ結果は...
P%7B3%27.RS5%2B3.3%27%7D
となりました。
近く実装の予定。
*** 2015年1月24日追加、更新、バグフィクス [#j787255e]
遺伝子記号などをパーセントエンコードするようにしたので(1...
基本的には全ての記号を FlyBase へリンクできるようになった。
そこで、
バランサーのリストの更新、
染色体異常の例外リスト更新、
ショウジョウバエ遺伝資源センター特有の事情となるかもしれ...
の insertion identifier の FlyBase との不一致
への対応を行った。
また、strict、warnings により文法のチェックを行い、文法に...
実運用では、万が一のエラーを回避するため、strict と warni...
アウトするといいかもしれない。
今後は、
- 染色体異常ではない記号($nonabberation)
- バランサーではなく染色体異常である記号($abberationnonb...
- バランサー($balancersymbols)
- FlyBaseへの挿入としてのリンクがinsertion identifier を...
の4つのリストをメンテナンスすればいいはず。~
$noinsertioninfbti、$nonabberation はたぶんほとんどメンテ...
目出つ更新は下のようなもの。
- バランサーのリスト、染色体異常の例外リストなどをFlyBase...
- 染色体異常の判断ロジックのバグ修正
- package MyString の sub copy のバグを修正(誤:=>、正:...
近く実装の予定。
*** 2018年4月19日 FlyBase のリンク方法変更への対応 [#a694...
FlyBase へのリンク方法が変更されていました。~
FlyBase のドキュメント
([[FlyBase:Links to and from FlyBase>https://wiki.flybas...
を読んでも埒が明かないので、ヘルプフォームから尋ねたとこ...
今回は3年前の3分の1の間隔。インディアナは時差14時間だ...
その結果~
-FlyBase のドキュメントが間違っていること~
-リンク付の遺伝子型から FlyBase へ飛ぶ URL の変更が必要な...
を教えていただきました。
これまで(遺伝子記号 w の検索の例)
http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=...
現在
http://flybase.org/search/symbol/FBgn/w
これは「おまじないの方法」(あちらの受け入れるリンク方法...
perl プログラムはそこだけ変更。実質2行だけ。~
zipファイル(&ref(link_to_flybase20180419.zip);)には~
- perl プログラム:genlink.pl
- 20150124版からの差分パッチ:genlink20180419.patch
- 遺伝子型サンプル:genotype.txt ← 以前のものと同じ
- テスト出力サンプル:out.html
を入れています。
実装済みです。
**方針は下のとおり [#n58ce573]
***1.FlyBase へのリンク [#d9815850]
our $hypertext1 = "http://flybase.org/search/symbol/FB";
#our $hypertext1 = "http://flybase.org/cgi-bin/uniq.html...
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
our $hypertext2 = "/";
#our $hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ
2018年4月19日修正
***2.クエリー文字列は例外を除き、下のようなものに [#b71...
- 遺伝子記号のときは、allele をカットする
- 挿入のときは、~
1) コンストラクトへのリンク~
2) 挿入そのもの(identifier含めて)へのリンク~
を作る
- コンストラトは「short」のタイプにする
(そうしないとFlyBaseは返さない)
- バランサーと染色体異常のときは、そのままリンクを作る
***3.遺伝子型から遺伝子記号、組換えコンストラクト、挿入...
- 組換えコンストラクト recombinant construct → Fbtp~
{と}で囲まれているものの左側は空白まで、右側は}まで~
バランサー名は除く
- 挿入 insertion → Fbti~
{と}で囲まれているものの外側で空白の間
- バランサー($balancersymbols):例示(ポジティブリスト...
(['Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc',...
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Bin...
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', '...
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS...
'Df\(1\)X-1-53B', 'Df\(2L\)TE99\(Z\)XW88-DV2',
'Df\(2L\)TE99\(Z\)XW88-DV3', 'Dp\(1\;Y\)y\[\+\]ac\[54e\]',
'Dp\(2\;Y\)G-P\{CaryP\}attPY', 'Dp\(2\;Y\)G-P\{mwh\.\+t3...
'Dp\(2\;2\)bw-DX7\.bw\[5\]', 'Dp\(2\;2\)bw-DX7\.bw\[D\]' ,
'Dp\(2\;2\)bw\[D\]-FRT', 'Dp\(2\;Y\)G-P\{hs-hid\}Y', 'fi...
'FM[0-6]', 'FM7[a-zA-Z]', 'FM[8-9]', 'Insc', 'Inscy',
'In\(2\)Heidi-P\{Winkelried\(-FRT\)\}',
'In\(2\)Heidi-P\{Winkelried\}D', 'In\(2LR\)12-12-w',
'In\(2R\)X2-5-w', 'LVM', 'M6-ML', 'M9', 'MKRS', 'MRS', '...
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\...
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;...
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(...
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]...
(2015年 1月24日 更新)~
FlyBase にある balancer を全て網羅
(FBba.xml.gz, FB2014_06, released November 12th, 2014)。
正規表現で利用
- 染色体異常 abberation → Fbab~
(を含み、例外以外
染色体異常ではない記号($nonabberation):例示(ポジテ...
([ '3Cy(', 'En(', 'Hto-WP(', 'Ifm(', 'M(', 'MENE(', 'Ms(...
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'ac...
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', '...
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', ...
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', ...
# 後方互換性のため:前回(25 April 2010)はあって、今回...
# 2015)は FlyBase に見つからなかったもの(↓)
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c...
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod(' ]);
(2015年 1月24日 更新)~
FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記号を
全てチェックした。index で有無と位置を調べる。
バランサーではなく染色体異常である記号($abberationnonb...
(['FM7']);
(2015年 1月24日 追加((FM7はバランサーではない。バランサ...
- FlyBaseへの挿入としてのリンクがinsertion identifier を...
(['l(2)k'])
(2015年 1月24日 追加)
- 遺伝子記号 gene → Fbgn~
その他残り全て
ポジティブリスト方式は漏れが出やすいので避けたい。
その結果、わけのわからないものが遺伝子記号としてリンクさ...
しかし、このような、
ポジティブリスト方式を取らずに自動でリンクを作る方法では...
- allele → Fbal(リンクは作らない)~
[と]で囲まれているもの
***4.リンクの例外(ネガティブリスト) [#l2662653]
運用してみて、多少の修正が必要かも(2015年 1月24日 更新)~
- リンクしない記号 = (['^0', ',\b']); # 正規表現
- リンクしない記号 = (['/', ';', ',', '+', '(', ')'...
- リンクしない末端の文字 = (['/', ';', ',', ':', '(', ')'...
***5.系統の遺伝子型を遺伝子記号等に分解する方法の修正 [...
- 「{」と「}」の間の空白は遺伝子記号の区分けではない
- そのほかは空白を区切りとしてよい
***6.遺伝子型ではなく、「series」で判断して、リンク不要...
- 例示(ポジティブリスト): W %%FlyTrap%% nonmel
**perl スクリプト [#sea458af]
コードは少しオブジェクト指向にしてしまいました。
こういう場合、構造化プログラミングよりも
オブジェクト指向プログラミングが適しているので。
とはいえ、perlでオブジェクト指向はほぼ初心者なので幼稚な...
プログラムを学んだ時期の手法(ANSI C 2.0、ANSI C++策定直...
ぼくにとっては一番作り易いので、
「少し」という程度のオブジェクト指向
(構造体に関数が入っている程度のClass)です。
動作確認はウィンドウズ用のActivePerlのみで行いました。
[更新 19 April 2018][更新 13 & 24 January 2015][追記...
#!perl
use strict;
use warnings;
# strict、warnings により文法のチェック
# 2015年 1月24日
#
########################################################...
#
# genlink.pl
# 系統の遺伝子型から FlyBase へのリンクを作る perl プロ...
# Copyright (c) TOMARU Masatoshi 19 April 2018
# Copyright (c) TOMARU Masatoshi 13 & 24 January 2015
# Copyright (c) TOMARU Masatoshi 25 April 2010
#
# 動作テスト環境(perl -vの出力)
# ---------------------------------------------
# This is perl, v5.10.1 built for MSWin32-x64-multi-thread
# (with 2 registered patches, see perl -V for more detail)
#
# Copyright 1987-2009, Larry Wall
#
# Binary build 1007 [291969] provided by ActiveState htt...
# Built Jan 27 2010 14:12:21
#
# Perl may be copied only under the terms of either the ...
# GNU General Public License, which may be found in the ...
#
# Complete documentation for Perl, including FAQ lists, ...
# this system using "man perl" or "perldoc perl". If yo...
# Internet, point your browser at http://www.perl.org/, ...
# ---------------------------------------------
#
# 現時点で GPL(GNU General Public License)を宣言すると
# 困る人が出る可能性があるので著作権は主張しておきます ...
#
# このプログラムの作成にあたっては、文法書の類を参照した...
# ほかの人の作ったプログラムの流用はしていません
# なお、クラス化[オブジェクト指向化]部分はまねしたもの...
# 具体的には、
# my $this = shift;
# こうするといい、とか
# bless $mystr, $this; ← コンストラクタの部分
# こうしないとインスタンスができない、とか
#
# FlyBase へのリンクは、現行のものを使いましたが
# これは著作権云々に当たらない部分なので問題なしと考えます
#
###########################
#
# 2015年 1月24日の修正
#
# 今後は、染色体異常ではない記号($nonabberation)とバ...
# 染色体異常である記号($abberationnonbalancer)、バラ...
# ($balancersymbols)、FlyBaseへの挿入としてのリンクが...
# identifier を使ってでは上手くいかない記号($noinserti...
# insertion identifier の行頭一致)の4つのリストをメン...
# いいはず
#
# $noinsertioninfbti、$nonabberation はたぶんほとんどメ...
#
#
# ・FlyBase (FB2014_06, released November 12th, 2014)...
# 遺伝子記号などを更新
#
# - 染色体異常ではない記号($nonabberation)を更新
# FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝...
#
# - バランサーではなく染色体異常である記号(ポジティブ...
# ($abberationnonbalancer)を新設
#
# - バランサー($balancersymbols)を更新
# FBba.xml.gz(FB2014_06, released November 12th, 201...
#
#
# ・FlyBase への検索クエリーで、検索する遺伝子記号などは...
# コードすることにした
#
# - uri_escape() (use URI::Escape;)を利用し % encode
#
# - 検索する遺伝子記号などを % encode するように変更し...
# ンクしない記号($nolinksymbols)の一部削除
#
#
# ・遺伝子記号の種類の判断を行う package MyString の sub...
# を修正
#
# - 染色体異常を判断するロジックのバグを修正
#
# - バランサーではなく染色体異常である記号(ポジティブ...
# ($abberationnonbalancer)の新設に対応し、判断を一...
# にした
#
# - バランサー($balancersymbols)の更新に対応し、バラ...
# ランサーではなく染色体異常である記号(ポジティブリ...
# ことにした
#
# - 染色体異常の判断ロジックのバグ修正、および染色体異...
# ($nonabberation)の更新に対応し、染色体異常の判断...
# 断の次に行うことにした
#
#
# ・ハイパーリンクを作成する package MyString の sub gen...
# を修正
#
# - allele名がないが、 identifierが P{lacW}l(2)k**** へ...
# ショウジョウバエ遺伝資源センター特有の事情
# l(2)k**** にはallele名がない系統がある
# FlyBase には、それは、l(2)k****[*****] とinsertion ...
# allele名が同じものとして登録されているようだが、全...
# ない
# そこで、そのようなinsertion identifier ($noinserti...
# ト:insertion identifier の行頭一致)、かつ、allele...
# (「[」と「]」の両方が揃っていない場合)は、挿入と...
# 伝子としてリンクし、FlyBaseへのリンクでエラーがない...
# l(2)k****[*****] のように insertion identifier を作...
# クもできるが、遺伝子へのリンクがより適切と考えた
#
#
# ・strict および warnings を使い、警告の出ないように文...
#
# - グローバル変数に our、ローカル変数に my を全て付けた
# $main::hogehoge で呼び出す必要がなくなったので、「$...
#
# - package MyString の sub copy のバグを修正(誤:=>、...
#
#
########################################################...
# 定数定義
#
# FlyBase へリンクするためのおまじないの変更 2018年4月19日
# 下のような返信をいただいたので
#
# From: Josh Goodman <*******@indiana.edu>
# Subject: Re: FB Help Mailer: 1239 Searches (problem or...
# Date: Thu, 19 Apr 2018 03:27:35 +0000
#
# (略)
#
# > The equivalent URL for
# > http://flybase.org/cgi-bin/uniq.html?species=Dmel&fi...
# >
# > is now
# >
# > http://flybase.org/search/symbol/FBgn/w
#
#
# FlyBase へリンクするためのおまじない
our $hypertext1 = "http://flybase.org/search/symbol/FB";
#our $hypertext1 = "http://flybase.org/cgi-bin/uniq.html...
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
our $hypertext2 = "/";
#our $hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ
# バランサーではなく染色体異常である記号(ポジティブリス...
# FM7は染色体異常、バランサーはFM7cなど
# 2015年 1月24日
our $abberationnonbalancer = ([
#
'FM7'
#
]);
# 染色体異常ではない記号
our $nonabberation = ([
#
'3Cy(', 'En(', 'Hto-WP(', 'Ifm(', 'M(', 'MENE(', 'Ms(', ...
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'ac...
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', '...
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', ...
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', ...
# 後方互換性のため:前回(25 April 2010)はあって、今回...
# 2015)は FlyBase に見つからなかったもの(↓)
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c...
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod('
]);
# index で有無と位置を調べる
# 「(」を含む遺伝子記号
# FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記...
# 全てチェックした 24 January 2015
# 前回の調査(25 April 2010)のときには FlyBase、または...
# 遺伝資源センターの系統 にあって、今回の FlyBase のみの...
# January 2015)では見つからなかったものは、後方互換性の...
# バランサー
our $balancersymbols = ([
#
'Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc',...
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Bin...
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', '...
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS...
'Df\(1\)X-1-53B', 'Df\(2L\)TE99\(Z\)XW88-DV2',
'Df\(2L\)TE99\(Z\)XW88-DV3', 'Dp\(1\;Y\)y\[\+\]ac\[54e\]',
'Dp\(2\;Y\)G-P\{CaryP\}attPY', 'Dp\(2\;Y\)G-P\{mwh\.\+t3...
'Dp\(2\;2\)bw-DX7\.bw\[5\]', 'Dp\(2\;2\)bw-DX7\.bw\[D\]' ,
'Dp\(2\;2\)bw\[D\]-FRT', 'Dp\(2\;Y\)G-P\{hs-hid\}Y', 'fi...
'FM[0-6]', 'FM7[a-zA-Z]', 'FM[8-9]', 'Insc', 'Inscy',
'In\(2\)Heidi-P\{Winkelried\(-FRT\)\}',
'In\(2\)Heidi-P\{Winkelried\}D', 'In\(2LR\)12-12-w',
'In\(2R\)X2-5-w', 'LVM', 'M6-ML', 'M9', 'MKRS', 'MRS', '...
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\...
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;...
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(...
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]...
#
]);
# FlyBase にある balancer を全て網羅
#(FBba.xml.gz、FB2014_06, released November 12th, 2014)
# 2015年 1月24日
# 正規表現で利用
# insertion identifier だけでは、FlyBase の insertion (f...
# ないもの(l(2)k***** など)
our $noinsertioninfbti = (['l(2)k']);
# 2015年 1月24日
# index で比較
# リンクしない記号
our $nolinksymbols = (['^0', ',\b']);
# 2015年 1月24日
#$nolinksymbols = (['^0', '^T\(', ',\b', ';']);
# 正規表現で利用
# リンクしない記号(完全一致する場合)
# '(' と ')'、'?' を追加 2015年 1月24日
our $nolinksymbols_perfect = (['/', ';', ',', '+', '('...
# eq で比較
# リンクしない末端の文字
# '(' と ')'、'?' を追加 2015年 1月24日
our $nolinksymbols_separater = (['/', ';', ',', ':', '('...
# eq で比較
########################################################...
#
# メインルーチンはテスト表示のためでしかない
#
########################################################...
package main;
print "<html>\n";
print "<title>Link to FlyBase</title>\n";
print "<body>\n";
print "<h3>Link to FlyBase</h3>\n";
print "<table>\n";
while(<>){
chop;
print "<tr>\n";
print "<td>Original:</td>\n<td>";
print;
print "\n</td></tr>\n";
print "<tr>\n";
print "<td>With Link:</td>\n<td>";
my @mysymbols = genotypesplit($_);
my $numsymbols = scalar(@mysymbols);
my $presentsymbol = new MyString;
for( my $mynum=0; $mynum<$numsymbols; $mynum++){
$presentsymbol->mytext($mysymbols[$mynum]);
$presentsymbol->printhypertext();
print " ";
}
print "</td></tr>\n";
print "<tr><td> </td></td>\n";
}
print "</table>\n";
print "</body>\n";
print "</html>\n";
# 系統の遺伝子型から遺伝子記号などに分解する
# これがミソでもあるが
# chopを使って作ったちょっと「せこい」感じのプログラム
sub genotypesplit{
my $mystring = $_[0]; # 可読性のためコピーする
my $mylength = length($mystring);
my $newstring = "";
my $mystatus = 0;
my @splitted = "";
for( my $i=0; $i<$mylength; $i++){
my $mychar = chop($mystring);
if($mychar eq '}'){
$mystatus = 1; # 中に入った!
}
if($mychar eq '{'){
$mystatus = 0; # 出た!
}
# 「{」と「}」の間の空白は遺伝子記号の区分けではない
if( ($mystatus == 1) && ($mychar eq ' ') ){
$mychar = '__MySpace__';
}
$newstring = $mychar . $newstring;
}
@splitted = split(/ /, $newstring);
$mylength = scalar(@splitted);
for( my $i=0; $i<$mylength; $i++){
$splitted[$i] =~ s/__MySpace__/ /;
# 空白を戻す
}
return @splitted;
}
########################################################...
#
# 「Class」 定義ここから
#
########################################################...
# 遺伝子記号文字列を Class 化する
# C++ なら、String のような感じかも
# 使わない関数もあるがひととおり作っている
package MyString;
# uri_escape() を使うために呼び出す
# package MyString のスコープ内で使うためにはここで呼び...
# 2015年1月13日追加
use URI::Escape;
# コンストラクタ
sub new{
my $this = shift;
my $mystr;
if( @_ ){
my $initMystr = shift;
$mystr = {
"mytext" => $initMystr->mytext(),
# 読み込んだ文字列
"category" => $initMystr->category(),
# FlyBaseのdbのカテゴリ
"ishyperlink" => $initMystr->ishyperlink(),
# ハイパーリンクを作るか否か
"withoutidentifier" => $initMystr->withoutidentif...
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => $initMystr->insertionident...
# insertion identifier のみ
"shortconstrust" => $initMystr->shortconstrust...
# recombinant construct の short expression
"shortinsertion" => $initMystr->shortinsertion...
# insertion を recombinant construct の short expre...
"myhypertext" => $initMystr->myhypertext()
# ハイパーリンク付テキスト
};
}else{
# デフォルトの初期化
$mystr = {
"mytext" => "",
# デフォルトは読み込んだ行は空の文字列
"category" => "gn",
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない:デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるの...
"ishyperlink" => 1,
# ハイパーリンクを作るか否か:デフォルト作る
"withoutidentifier" => "",
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => "",
# insertion identifier のみ
"shortconstrust" => "",
# recombinant construct の short expression
"shortinsertion" => "",
# insertion を recombinant construct の short expre...
"myhypertext" => "" # ハイパーリンク付テキ...
} ;
}
bless $mystr, $this;
return $mystr;
}
# デフォルトに初期化(newと一緒にできるほうがいいのだが…...
sub initialize{
my $this = shift;
$this->{mytext} = "";
# デフォルトは読み込んだ行は空の文字列
$this->{category} = "gn";
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない:デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるので...
$this->{ishyperlink} = 1;
# ハイパーリンクを作るか否か:デフォルト作る
$this->{withoutidentifier} = "";
# 元々のコンストラクトで insertion identifier なし
$this->{insertionidentifier} = "";
# insertion identifier のみ
$this->{shortconstrust} = "";
# recombinant construct の short expression
$this->{shortinsertion} = "";
# insertion を recombinant construct の short expres...
$this->{myhypertext} = ""; # ハイパーリンク付テキスト
}
# sub DESTROY{
# my $this = shift;
#
# print "DESTROY\n";
# }
sub copy{
#バグを修正(誤:=>、正:=) 2015年 1月24日
my $this = shift;
if( @_ ){
my $mystr = shift;
$this->{mytext} = $mystr->mytext();
$this->{category} = $mystr->category();
$this->{ishyperlink} = $mystr->ishyperlink();
$this->{withoutidentifier} = $mystr->withoutidentifie...
$this->{insertionidentifier} = $mystr->insertionidentif...
$this->{shortconstrust} = $mystr->shortconstrust();
$this->{shortinsertion} = $mystr->shortinsertion();
$this->{myhypertext} = $mystr->myhypertext();
}
return $this;
}
sub mytext{
my $this = shift;
# mytextが更新されたら、ほかの情報を初期化し処理し直す
$this->initialize();
if( @_ ){
$this->{mytext} = shift;
$this->generatehypertext();
}
return $this->{mytext};
}
sub category{
my $this = shift;
if( @_ ){
$this->{category} = shift;
}
return $this->{category};
}
sub ishyperlink{
my $this = shift;
if( @_ ){
$this->{ishyperlink} = shift;
}
return $this->{ishyperlink};
}
sub withoutidentifier{
my $this = shift;
if( @_ ){
$this->{withoutidentifier} = shift;
}
return $this->{withoutidentifier};
}
sub insertionidentifier{
my $this = shift;
if( @_ ){
$this->{insertionidentifier} = shift;
}
return $this->{insertionidentifier};
}
sub shortconstrust{
my $this = shift;
if( @_ ){
$this->{shortconstrust} = shift;
}
return $this->{shortconstrust};
}
sub shortinsertion{
my $this = shift;
if( @_ ){
$this->{shortinsertion} = shift;
}
return $this->{shortinsertion};
}
sub myhypertext{
my $this = shift;
if( @_ ){
$this->{myhypertext} = shift;
}
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
return $this->{myhypertext};
}
sub printtext{
my $this = shift;
print $this->{mytext};
}
sub printhypertext{
my $this = shift;
# 一々動かすのは無駄だけど、一回ずつ作り直すことにする
# テストくらいしか使わないだろうし
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
print $this->{myhypertext};
}
# ハイパーテキストを作る
# 遺伝子記号、挿入、バランサー、染色体異常で少しずつ異な...
sub generatehypertext{
my $this = shift;
$this->processmytext();
$this->{myhypertext} = ""; # 先にデータがあっても消す
if ( !($this->{ishyperlink}) ){
# ハイパーテキストを作らないときは、テキストをしまっ...
$this->{myhypertext} .= $this->{mytext};
} else {
$this->{myhypertext} .= "<a href=\"";
if( $this->{category} eq "gn"){
# 遺伝子記号のときは、allele をカットしてリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->dropallele( $this->{mytext} ),
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} elsif( $this->{category} eq 'tp'){
# 挿入のときは、
# 1.コンストラクトへのリンク
# 2.挿入そのもの(identifier含めて)へのリンク
# を作る
# コンストラトは「short」のタイプにしないとFlyBaseは返...
$this->{myhypertext} .=
$this->makelink(
$this->{shortconstrust},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{withoutidentifier};
$this->{myhypertext} .= "</a>";
# ショウジョウバエ遺伝資源センター特有の事情で……
# l(2)k**** にはallele名がない系統がある
# FlyBase には、それは、l(2)k****[*****] とinsertion
# identifier と allele名が同じものとして登録されて...
# だが、全て確認した訳ではない
# そこで、そのようなinsertion identifier
# ($noinsertioninfbti にリスト:insertion identifi...
# 頭一致)、かつ、allele名がない場合(「[」と「]」...
# 揃っていない場合)は、挿入としてではなく、遺伝子...
# ンクし、FlyBaseへのリンクでエラーがないように修正...
# insertionidentifier が遺伝子名
# l(2)k****[*****] のように insertion identifier を...
# 入へリンクもできるが、遺伝子へのリンクがより適切...
# 2015年 1月24日
my $listsymbolnumber = scalar(@{$noinsertioninfbti});
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i+...
if( (index($this->{insertionidentifier},
@{$noinsertioninfbti}[$my_i] ) == 0 ) &&
!((index($this->{insertionidentifier}, "\[") > 0) &&
(index($this->{insertionidentifier}, "\]") > 0) )
){
$this->{myhypertext} .= "<a href=\"";
$this->{myhypertext} .=
$this->makelink(
$this->{insertionidentifier},
"gn"
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{insertionidentifie...
$this->{myhypertext} .= "</a>";
return $this->{myhypertext};
}
}
if( $this->{insertionidentifier} ){
# identifierがない場合、当然リンクは作らない
$this->{myhypertext} .= "<a href=\"";
$this->{myhypertext} .=
$this->makelink(
$this->{shortinsertion},
"ti"
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{insertionidentifier};
$this->{myhypertext} .= "</a>";
}
} elsif( ($this->{category} eq "ba") ||
($this->{category} eq "ab") ) {
# バランサーと染色体異常のときは、そのままリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->{mytext},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} else{
# その他は存在させないが原則だが、
# 念のため、リンクなしを作るようにしておく
$this->{myhypertext} = $this->{mytext};
# 意識してドットなしイコールにしているので注意
}
}
return $this->{myhypertext};
}
# sub generatehypertextで使うサブルーチン
sub processmytext{
my $this = shift;
$this->whichcateogry();
# $this->{category} = "gn";
# $this->{category} = "tp";
# $this->{category} = "ab";
# $this->{category} = "ba";
# $this->{ishyperlink} = 1;
# $this->{ishyperlink} = 0;
if($this->{category} eq "tp"){
# 挿入のときは、道具を作っておく
$this->{withoutidentifier} = $this->makeswithoutident...
$this->{insertionidentifier} = $this->makesinsertionide...
$this->{shortconstrust} = $this->makeshortconstruc...
$this->{shortinsertion} =
$this->{shortconstrust} . $this->{insertionidentifi...
}
}
# 記号の種類を判断する
sub whichcateogry{
my $this = shift;
if( $this->isabberationnobalancer($this->{mytext}) ){
# 染色体異常であってバランサーでないもの(ポジティブ...
# 2015年 1月24日
$this->{category} = "ab";
$this->{ishyperlink} = 1;
} elsif( $this->isbalancer($this->{mytext}) ){
# バランサーを判断する 2015年 1月24日
# P{***} の名前を持つバランサーがあるなどへも対応で...
# バランサー:指定しているもののみ
$this->{category} = "ba";
$this->{ishyperlink} = 1;
} elsif( index($this->{mytext}, "(") > 0 ) {
# 染色体異常を判断する 2015年 1月24日
# 染色体異常は「(」を含むが
# 「l(2)」などではない($nonabberation に遺伝子記号...
$this->{category} = "ab";
my $listsymbolnumber = scalar(@{$nonabberation});
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( (index($this->{mytext},'{') > 0) ){
# 「{」があれば挿入、要リンク # 2015年 1月24日追加
$this->{category} = "tp";
$this->{ishyperlink} = 1;
}elsif( index($this->{mytext},
@{$nonabberation}[$my_i] ) >= 0 ){
$this->{category} = "gn";
$this->{ishyperlink} = 1; # 2015年 1月24日追加
}
}
} elsif( (index($this->{mytext},'{') > 0) ){
# 「{」があれば挿入、要リンク
$this->{category} = "tp";
$this->{ishyperlink} = 1;
} elsif( $this->isnolink($this->{mytext}) ){
# リンク不要の記号
$this->{ishyperlink} = 0;
# } else {
} elsif( $this->{ishyperlink} ) {
# デフォルトはリンク要
# 上で判断できなかったものは遺伝子記号としてリンクを...
$this->{category} = "gn";
$this->{ishyperlink} = 1;
# 結果として、わけのわからないものが遺伝子記号としてリ...
# る可能性がある
}
}
# バランサーか否かを判断する
sub isbalancer{
my $this = shift;
my $mysymbol = $_[0];
my $listsymbolnumber = scalar(@{$balancersymbols});
my $my_i = 0;
# $balancersymbols に含まれていたら、バランサーでは...
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ : EXPRがRE(正規表現で)
# 含まれると 1 を返すので if 内で正偽の判断ができる
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$balancersymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# 染色体異常であってバランサーでないものを判断する
# 2015年 1月24日
sub isabberationnobalancer{
my $this = shift;
my $mysymbol = $_[0];
my $listsymbolnumber = scalar(@{$abberationnonbalanc...
my $my_i = 0;
# 染色体異常であってバランサーでないものを検査
# eq を使って完全一致のみで判断
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol eq @{$abberationnonbalancer}[$my_i] ){
return 1;
}
}
return 0;
}
# リンク不要かどうか判断する
# 注意!不要なら「1」を返す
sub isnolink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $listsymbolnumber = 0;
my $my_i = 0;
# 全くリンクしないもの
$listsymbolnumber = scalar(@{$nolinksymbols_perfect});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol eq @{$nolinksymbols_perfect}[$my_i] ){
return 1;
}
}
# 正規表現で検査する前に、
# 最後のひと文字がコンマなどのときはカットしておく
# 最初のひと文字がコンマなどのときはカットしておく #...
$listsymbolnumber = scalar(@{$nolinksymbols_separate...
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最後のひと文字は念のため2度繰り返しておく 「(or?)...
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最初のひと文字が丸括弧などのときはカットしておく #...
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, 0, 1) eq
@{$nolinksymbols_separater}[$my_i] ){
$mysymbol =~ s/^.//;
}
}
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ : EXPRがRE(正規表現で)
# 含まれると 1 を返すので if 内で正偽の判断ができる
$listsymbolnumber = scalar(@{$nolinksymbols});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$nolinksymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# リンク文字列を作成する
# URLを返すだけ
sub makelink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $mycategory = $_[1]; # 可読性のため
my $temp = "";
$temp .= $hypertext1;
$temp .= $mycategory;
$temp .= $hypertext2;
# 最後のひと文字がコンマなどのときはリンク文字列から...
my $listsymbolnumber = scalar(@{$nolinksymbols_separ...
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最後のひと文字は念のため2度繰り返しておく 「(or?)...
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最初のひと文字が丸括弧などのときはカットしておく
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, 0, 1) eq
@{$nolinksymbols_separater}[$my_i] ){
$mysymbol =~ s/^.//;
}
}
$temp .= uri_escape($mysymbol);
# uri_escapeを追加 query に使う遺伝子記号などをエス...
return $temp;
}
# 挿入の記号から、identifierを取り除く
sub makeswithoutidentifier{
my $this = shift;
my $lastparen = rindex($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},0,($lastparen+1));
return $temp;
}
# 挿入の記号から、identifierだけを返す
sub makesinsertionidentifier{
my $this = shift;
my $lastparen = index($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},($lastparen+1));
return $temp;
}
# 挿入の記号から、shortのconstructを作る
sub makeshortconstruct{
my $this = shift;
my $firstparen = index($this->{mytext},'{');
my $lastequal = rindex($this->{mytext},'=');
my $lastparen = 0;
my $temp = "";
$temp .= substr($this->{mytext},0,($firstparen+1));
if($lastequal<0){
# もともと short のときは元に戻るように細工しておく
$lastequal = $firstparen;
}
$temp .= substr($this->{mytext}, ($lastequal+1));
$lastparen = index($temp,'}');
$temp = substr($temp, 0, ($lastparen+1));
return $temp;
}
# allele の部分([と]で囲まれた部分)を削る
# そのようなものがなければ(表記としてはヘンなのだが)、
# 当然そのままにしておく
sub dropallele{
my $this = shift;
my $myparam = $_[0]; # 可読性のため
my $myfirst = rindex($myparam,'[');
if($myfirst>0){
return substr( $myparam, 0, $myfirst);
} else {
return $myparam;
}
}
# 「Class」 定義ここまで
#
########################################################...
**出力例&サンプル [#p63cf8fc]
出力例 → [[こちら>http://www.cis.kit.ac.jp/~tomaru/pukiwi...
パッチ入り → &ref(link_to_flybase20180419.zip);~
//ドラッグ&ドロップで使えるもの(サンプル入り) → &ref(l...
古いものも残しおきます。
深い意味はありません。
|Today:&counter(today);|Yesterday:&counter(yesterday);|To...
終了行:
#contents
*系統の遺伝子型から FlyBase へのリンクを作る perl プログ...
ショウジョウバエ遺伝資源センターでは系統リスト
(http://kyotofly.kit.jp/stocks/)の遺伝子型から
FlyBase へリンクを張っています。
ですが、現在は遺伝子記号(gene symbol)に対してのみしかで...
そこで、もう少し「上手に」リンクを張るために遺伝子型から
リンクを作成するperlのサンプルプログラムを作成しました。
もう少ししたらこれと同じような仕様に変わるでしょう。
実運用に使われるかどうかはわかりません((実装されました))。
ま、とにかく動けばいいのです。
以下の perlスクリプトは、テスト用に html ファイルを stdou...
プログラムはあまり時間を掛けずに書いたので
(一晩でと言いたいところですが、もう少しかかってしまいま...
ボロがあると思います。
今見ると直したい気になるが、ま、いっか((がしかし、今日、...
*** 2015年1月15日追加 [#t2655fdd]
URI unsafe な construct symbol がある場合、
そのままブラウザによる「% encoding」に任せると FlyBase で...
例えば、
P{w[+mW.Scer\FRT.hs3]=3'.RS5+3.3'}
を short construct の形
P{3'.RS5+3.3'}
にしただけではだめ。
これは FlyBase の仕様なのかと思って、
プログラムを直してくれるとうれしいと
FlyBase にコメントを送ったら(本日12時頃)、
速攻で(1時間後くらいに)エスケープが間違っちょる、と返事...
(すごいっ、Josh Goodman さん!)。
そこで、こちらも速攻で perl を作り直しました。
URI query に使う遺伝子記号などの symbol を uri_escape し...
下のスクリプトでは
$temp .= uri_escape($mysymbol);
の部分(もう1行おまじないもあります)。エスケープ結果は...
P%7B3%27.RS5%2B3.3%27%7D
となりました。
近く実装の予定。
*** 2015年1月24日追加、更新、バグフィクス [#j787255e]
遺伝子記号などをパーセントエンコードするようにしたので(1...
基本的には全ての記号を FlyBase へリンクできるようになった。
そこで、
バランサーのリストの更新、
染色体異常の例外リスト更新、
ショウジョウバエ遺伝資源センター特有の事情となるかもしれ...
の insertion identifier の FlyBase との不一致
への対応を行った。
また、strict、warnings により文法のチェックを行い、文法に...
実運用では、万が一のエラーを回避するため、strict と warni...
アウトするといいかもしれない。
今後は、
- 染色体異常ではない記号($nonabberation)
- バランサーではなく染色体異常である記号($abberationnonb...
- バランサー($balancersymbols)
- FlyBaseへの挿入としてのリンクがinsertion identifier を...
の4つのリストをメンテナンスすればいいはず。~
$noinsertioninfbti、$nonabberation はたぶんほとんどメンテ...
目出つ更新は下のようなもの。
- バランサーのリスト、染色体異常の例外リストなどをFlyBase...
- 染色体異常の判断ロジックのバグ修正
- package MyString の sub copy のバグを修正(誤:=>、正:...
近く実装の予定。
*** 2018年4月19日 FlyBase のリンク方法変更への対応 [#a694...
FlyBase へのリンク方法が変更されていました。~
FlyBase のドキュメント
([[FlyBase:Links to and from FlyBase>https://wiki.flybas...
を読んでも埒が明かないので、ヘルプフォームから尋ねたとこ...
今回は3年前の3分の1の間隔。インディアナは時差14時間だ...
その結果~
-FlyBase のドキュメントが間違っていること~
-リンク付の遺伝子型から FlyBase へ飛ぶ URL の変更が必要な...
を教えていただきました。
これまで(遺伝子記号 w の検索の例)
http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=...
現在
http://flybase.org/search/symbol/FBgn/w
これは「おまじないの方法」(あちらの受け入れるリンク方法...
perl プログラムはそこだけ変更。実質2行だけ。~
zipファイル(&ref(link_to_flybase20180419.zip);)には~
- perl プログラム:genlink.pl
- 20150124版からの差分パッチ:genlink20180419.patch
- 遺伝子型サンプル:genotype.txt ← 以前のものと同じ
- テスト出力サンプル:out.html
を入れています。
実装済みです。
**方針は下のとおり [#n58ce573]
***1.FlyBase へのリンク [#d9815850]
our $hypertext1 = "http://flybase.org/search/symbol/FB";
#our $hypertext1 = "http://flybase.org/cgi-bin/uniq.html...
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
our $hypertext2 = "/";
#our $hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ
2018年4月19日修正
***2.クエリー文字列は例外を除き、下のようなものに [#b71...
- 遺伝子記号のときは、allele をカットする
- 挿入のときは、~
1) コンストラクトへのリンク~
2) 挿入そのもの(identifier含めて)へのリンク~
を作る
- コンストラトは「short」のタイプにする
(そうしないとFlyBaseは返さない)
- バランサーと染色体異常のときは、そのままリンクを作る
***3.遺伝子型から遺伝子記号、組換えコンストラクト、挿入...
- 組換えコンストラクト recombinant construct → Fbtp~
{と}で囲まれているものの左側は空白まで、右側は}まで~
バランサー名は除く
- 挿入 insertion → Fbti~
{と}で囲まれているものの外側で空白の間
- バランサー($balancersymbols):例示(ポジティブリスト...
(['Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc',...
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Bin...
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', '...
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS...
'Df\(1\)X-1-53B', 'Df\(2L\)TE99\(Z\)XW88-DV2',
'Df\(2L\)TE99\(Z\)XW88-DV3', 'Dp\(1\;Y\)y\[\+\]ac\[54e\]',
'Dp\(2\;Y\)G-P\{CaryP\}attPY', 'Dp\(2\;Y\)G-P\{mwh\.\+t3...
'Dp\(2\;2\)bw-DX7\.bw\[5\]', 'Dp\(2\;2\)bw-DX7\.bw\[D\]' ,
'Dp\(2\;2\)bw\[D\]-FRT', 'Dp\(2\;Y\)G-P\{hs-hid\}Y', 'fi...
'FM[0-6]', 'FM7[a-zA-Z]', 'FM[8-9]', 'Insc', 'Inscy',
'In\(2\)Heidi-P\{Winkelried\(-FRT\)\}',
'In\(2\)Heidi-P\{Winkelried\}D', 'In\(2LR\)12-12-w',
'In\(2R\)X2-5-w', 'LVM', 'M6-ML', 'M9', 'MKRS', 'MRS', '...
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\...
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;...
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(...
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]...
(2015年 1月24日 更新)~
FlyBase にある balancer を全て網羅
(FBba.xml.gz, FB2014_06, released November 12th, 2014)。
正規表現で利用
- 染色体異常 abberation → Fbab~
(を含み、例外以外
染色体異常ではない記号($nonabberation):例示(ポジテ...
([ '3Cy(', 'En(', 'Hto-WP(', 'Ifm(', 'M(', 'MENE(', 'Ms(...
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'ac...
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', '...
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', ...
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', ...
# 後方互換性のため:前回(25 April 2010)はあって、今回...
# 2015)は FlyBase に見つからなかったもの(↓)
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c...
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod(' ]);
(2015年 1月24日 更新)~
FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記号を
全てチェックした。index で有無と位置を調べる。
バランサーではなく染色体異常である記号($abberationnonb...
(['FM7']);
(2015年 1月24日 追加((FM7はバランサーではない。バランサ...
- FlyBaseへの挿入としてのリンクがinsertion identifier を...
(['l(2)k'])
(2015年 1月24日 追加)
- 遺伝子記号 gene → Fbgn~
その他残り全て
ポジティブリスト方式は漏れが出やすいので避けたい。
その結果、わけのわからないものが遺伝子記号としてリンクさ...
しかし、このような、
ポジティブリスト方式を取らずに自動でリンクを作る方法では...
- allele → Fbal(リンクは作らない)~
[と]で囲まれているもの
***4.リンクの例外(ネガティブリスト) [#l2662653]
運用してみて、多少の修正が必要かも(2015年 1月24日 更新)~
- リンクしない記号 = (['^0', ',\b']); # 正規表現
- リンクしない記号 = (['/', ';', ',', '+', '(', ')'...
- リンクしない末端の文字 = (['/', ';', ',', ':', '(', ')'...
***5.系統の遺伝子型を遺伝子記号等に分解する方法の修正 [...
- 「{」と「}」の間の空白は遺伝子記号の区分けではない
- そのほかは空白を区切りとしてよい
***6.遺伝子型ではなく、「series」で判断して、リンク不要...
- 例示(ポジティブリスト): W %%FlyTrap%% nonmel
**perl スクリプト [#sea458af]
コードは少しオブジェクト指向にしてしまいました。
こういう場合、構造化プログラミングよりも
オブジェクト指向プログラミングが適しているので。
とはいえ、perlでオブジェクト指向はほぼ初心者なので幼稚な...
プログラムを学んだ時期の手法(ANSI C 2.0、ANSI C++策定直...
ぼくにとっては一番作り易いので、
「少し」という程度のオブジェクト指向
(構造体に関数が入っている程度のClass)です。
動作確認はウィンドウズ用のActivePerlのみで行いました。
[更新 19 April 2018][更新 13 & 24 January 2015][追記...
#!perl
use strict;
use warnings;
# strict、warnings により文法のチェック
# 2015年 1月24日
#
########################################################...
#
# genlink.pl
# 系統の遺伝子型から FlyBase へのリンクを作る perl プロ...
# Copyright (c) TOMARU Masatoshi 19 April 2018
# Copyright (c) TOMARU Masatoshi 13 & 24 January 2015
# Copyright (c) TOMARU Masatoshi 25 April 2010
#
# 動作テスト環境(perl -vの出力)
# ---------------------------------------------
# This is perl, v5.10.1 built for MSWin32-x64-multi-thread
# (with 2 registered patches, see perl -V for more detail)
#
# Copyright 1987-2009, Larry Wall
#
# Binary build 1007 [291969] provided by ActiveState htt...
# Built Jan 27 2010 14:12:21
#
# Perl may be copied only under the terms of either the ...
# GNU General Public License, which may be found in the ...
#
# Complete documentation for Perl, including FAQ lists, ...
# this system using "man perl" or "perldoc perl". If yo...
# Internet, point your browser at http://www.perl.org/, ...
# ---------------------------------------------
#
# 現時点で GPL(GNU General Public License)を宣言すると
# 困る人が出る可能性があるので著作権は主張しておきます ...
#
# このプログラムの作成にあたっては、文法書の類を参照した...
# ほかの人の作ったプログラムの流用はしていません
# なお、クラス化[オブジェクト指向化]部分はまねしたもの...
# 具体的には、
# my $this = shift;
# こうするといい、とか
# bless $mystr, $this; ← コンストラクタの部分
# こうしないとインスタンスができない、とか
#
# FlyBase へのリンクは、現行のものを使いましたが
# これは著作権云々に当たらない部分なので問題なしと考えます
#
###########################
#
# 2015年 1月24日の修正
#
# 今後は、染色体異常ではない記号($nonabberation)とバ...
# 染色体異常である記号($abberationnonbalancer)、バラ...
# ($balancersymbols)、FlyBaseへの挿入としてのリンクが...
# identifier を使ってでは上手くいかない記号($noinserti...
# insertion identifier の行頭一致)の4つのリストをメン...
# いいはず
#
# $noinsertioninfbti、$nonabberation はたぶんほとんどメ...
#
#
# ・FlyBase (FB2014_06, released November 12th, 2014)...
# 遺伝子記号などを更新
#
# - 染色体異常ではない記号($nonabberation)を更新
# FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝...
#
# - バランサーではなく染色体異常である記号(ポジティブ...
# ($abberationnonbalancer)を新設
#
# - バランサー($balancersymbols)を更新
# FBba.xml.gz(FB2014_06, released November 12th, 201...
#
#
# ・FlyBase への検索クエリーで、検索する遺伝子記号などは...
# コードすることにした
#
# - uri_escape() (use URI::Escape;)を利用し % encode
#
# - 検索する遺伝子記号などを % encode するように変更し...
# ンクしない記号($nolinksymbols)の一部削除
#
#
# ・遺伝子記号の種類の判断を行う package MyString の sub...
# を修正
#
# - 染色体異常を判断するロジックのバグを修正
#
# - バランサーではなく染色体異常である記号(ポジティブ...
# ($abberationnonbalancer)の新設に対応し、判断を一...
# にした
#
# - バランサー($balancersymbols)の更新に対応し、バラ...
# ランサーではなく染色体異常である記号(ポジティブリ...
# ことにした
#
# - 染色体異常の判断ロジックのバグ修正、および染色体異...
# ($nonabberation)の更新に対応し、染色体異常の判断...
# 断の次に行うことにした
#
#
# ・ハイパーリンクを作成する package MyString の sub gen...
# を修正
#
# - allele名がないが、 identifierが P{lacW}l(2)k**** へ...
# ショウジョウバエ遺伝資源センター特有の事情
# l(2)k**** にはallele名がない系統がある
# FlyBase には、それは、l(2)k****[*****] とinsertion ...
# allele名が同じものとして登録されているようだが、全...
# ない
# そこで、そのようなinsertion identifier ($noinserti...
# ト:insertion identifier の行頭一致)、かつ、allele...
# (「[」と「]」の両方が揃っていない場合)は、挿入と...
# 伝子としてリンクし、FlyBaseへのリンクでエラーがない...
# l(2)k****[*****] のように insertion identifier を作...
# クもできるが、遺伝子へのリンクがより適切と考えた
#
#
# ・strict および warnings を使い、警告の出ないように文...
#
# - グローバル変数に our、ローカル変数に my を全て付けた
# $main::hogehoge で呼び出す必要がなくなったので、「$...
#
# - package MyString の sub copy のバグを修正(誤:=>、...
#
#
########################################################...
# 定数定義
#
# FlyBase へリンクするためのおまじないの変更 2018年4月19日
# 下のような返信をいただいたので
#
# From: Josh Goodman <*******@indiana.edu>
# Subject: Re: FB Help Mailer: 1239 Searches (problem or...
# Date: Thu, 19 Apr 2018 03:27:35 +0000
#
# (略)
#
# > The equivalent URL for
# > http://flybase.org/cgi-bin/uniq.html?species=Dmel&fi...
# >
# > is now
# >
# > http://flybase.org/search/symbol/FBgn/w
#
#
# FlyBase へリンクするためのおまじない
our $hypertext1 = "http://flybase.org/search/symbol/FB";
#our $hypertext1 = "http://flybase.org/cgi-bin/uniq.html...
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
our $hypertext2 = "/";
#our $hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ
# バランサーではなく染色体異常である記号(ポジティブリス...
# FM7は染色体異常、バランサーはFM7cなど
# 2015年 1月24日
our $abberationnonbalancer = ([
#
'FM7'
#
]);
# 染色体異常ではない記号
our $nonabberation = ([
#
'3Cy(', 'En(', 'Hto-WP(', 'Ifm(', 'M(', 'MENE(', 'Ms(', ...
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'ac...
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', '...
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', ...
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', ...
# 後方互換性のため:前回(25 April 2010)はあって、今回...
# 2015)は FlyBase に見つからなかったもの(↓)
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c...
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod('
]);
# index で有無と位置を調べる
# 「(」を含む遺伝子記号
# FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記...
# 全てチェックした 24 January 2015
# 前回の調査(25 April 2010)のときには FlyBase、または...
# 遺伝資源センターの系統 にあって、今回の FlyBase のみの...
# January 2015)では見つからなかったものは、後方互換性の...
# バランサー
our $balancersymbols = ([
#
'Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc',...
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Bin...
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', '...
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS...
'Df\(1\)X-1-53B', 'Df\(2L\)TE99\(Z\)XW88-DV2',
'Df\(2L\)TE99\(Z\)XW88-DV3', 'Dp\(1\;Y\)y\[\+\]ac\[54e\]',
'Dp\(2\;Y\)G-P\{CaryP\}attPY', 'Dp\(2\;Y\)G-P\{mwh\.\+t3...
'Dp\(2\;2\)bw-DX7\.bw\[5\]', 'Dp\(2\;2\)bw-DX7\.bw\[D\]' ,
'Dp\(2\;2\)bw\[D\]-FRT', 'Dp\(2\;Y\)G-P\{hs-hid\}Y', 'fi...
'FM[0-6]', 'FM7[a-zA-Z]', 'FM[8-9]', 'Insc', 'Inscy',
'In\(2\)Heidi-P\{Winkelried\(-FRT\)\}',
'In\(2\)Heidi-P\{Winkelried\}D', 'In\(2LR\)12-12-w',
'In\(2R\)X2-5-w', 'LVM', 'M6-ML', 'M9', 'MKRS', 'MRS', '...
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\...
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;...
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(...
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]...
#
]);
# FlyBase にある balancer を全て網羅
#(FBba.xml.gz、FB2014_06, released November 12th, 2014)
# 2015年 1月24日
# 正規表現で利用
# insertion identifier だけでは、FlyBase の insertion (f...
# ないもの(l(2)k***** など)
our $noinsertioninfbti = (['l(2)k']);
# 2015年 1月24日
# index で比較
# リンクしない記号
our $nolinksymbols = (['^0', ',\b']);
# 2015年 1月24日
#$nolinksymbols = (['^0', '^T\(', ',\b', ';']);
# 正規表現で利用
# リンクしない記号(完全一致する場合)
# '(' と ')'、'?' を追加 2015年 1月24日
our $nolinksymbols_perfect = (['/', ';', ',', '+', '('...
# eq で比較
# リンクしない末端の文字
# '(' と ')'、'?' を追加 2015年 1月24日
our $nolinksymbols_separater = (['/', ';', ',', ':', '('...
# eq で比較
########################################################...
#
# メインルーチンはテスト表示のためでしかない
#
########################################################...
package main;
print "<html>\n";
print "<title>Link to FlyBase</title>\n";
print "<body>\n";
print "<h3>Link to FlyBase</h3>\n";
print "<table>\n";
while(<>){
chop;
print "<tr>\n";
print "<td>Original:</td>\n<td>";
print;
print "\n</td></tr>\n";
print "<tr>\n";
print "<td>With Link:</td>\n<td>";
my @mysymbols = genotypesplit($_);
my $numsymbols = scalar(@mysymbols);
my $presentsymbol = new MyString;
for( my $mynum=0; $mynum<$numsymbols; $mynum++){
$presentsymbol->mytext($mysymbols[$mynum]);
$presentsymbol->printhypertext();
print " ";
}
print "</td></tr>\n";
print "<tr><td> </td></td>\n";
}
print "</table>\n";
print "</body>\n";
print "</html>\n";
# 系統の遺伝子型から遺伝子記号などに分解する
# これがミソでもあるが
# chopを使って作ったちょっと「せこい」感じのプログラム
sub genotypesplit{
my $mystring = $_[0]; # 可読性のためコピーする
my $mylength = length($mystring);
my $newstring = "";
my $mystatus = 0;
my @splitted = "";
for( my $i=0; $i<$mylength; $i++){
my $mychar = chop($mystring);
if($mychar eq '}'){
$mystatus = 1; # 中に入った!
}
if($mychar eq '{'){
$mystatus = 0; # 出た!
}
# 「{」と「}」の間の空白は遺伝子記号の区分けではない
if( ($mystatus == 1) && ($mychar eq ' ') ){
$mychar = '__MySpace__';
}
$newstring = $mychar . $newstring;
}
@splitted = split(/ /, $newstring);
$mylength = scalar(@splitted);
for( my $i=0; $i<$mylength; $i++){
$splitted[$i] =~ s/__MySpace__/ /;
# 空白を戻す
}
return @splitted;
}
########################################################...
#
# 「Class」 定義ここから
#
########################################################...
# 遺伝子記号文字列を Class 化する
# C++ なら、String のような感じかも
# 使わない関数もあるがひととおり作っている
package MyString;
# uri_escape() を使うために呼び出す
# package MyString のスコープ内で使うためにはここで呼び...
# 2015年1月13日追加
use URI::Escape;
# コンストラクタ
sub new{
my $this = shift;
my $mystr;
if( @_ ){
my $initMystr = shift;
$mystr = {
"mytext" => $initMystr->mytext(),
# 読み込んだ文字列
"category" => $initMystr->category(),
# FlyBaseのdbのカテゴリ
"ishyperlink" => $initMystr->ishyperlink(),
# ハイパーリンクを作るか否か
"withoutidentifier" => $initMystr->withoutidentif...
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => $initMystr->insertionident...
# insertion identifier のみ
"shortconstrust" => $initMystr->shortconstrust...
# recombinant construct の short expression
"shortinsertion" => $initMystr->shortinsertion...
# insertion を recombinant construct の short expre...
"myhypertext" => $initMystr->myhypertext()
# ハイパーリンク付テキスト
};
}else{
# デフォルトの初期化
$mystr = {
"mytext" => "",
# デフォルトは読み込んだ行は空の文字列
"category" => "gn",
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない:デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるの...
"ishyperlink" => 1,
# ハイパーリンクを作るか否か:デフォルト作る
"withoutidentifier" => "",
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => "",
# insertion identifier のみ
"shortconstrust" => "",
# recombinant construct の short expression
"shortinsertion" => "",
# insertion を recombinant construct の short expre...
"myhypertext" => "" # ハイパーリンク付テキ...
} ;
}
bless $mystr, $this;
return $mystr;
}
# デフォルトに初期化(newと一緒にできるほうがいいのだが…...
sub initialize{
my $this = shift;
$this->{mytext} = "";
# デフォルトは読み込んだ行は空の文字列
$this->{category} = "gn";
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない:デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるので...
$this->{ishyperlink} = 1;
# ハイパーリンクを作るか否か:デフォルト作る
$this->{withoutidentifier} = "";
# 元々のコンストラクトで insertion identifier なし
$this->{insertionidentifier} = "";
# insertion identifier のみ
$this->{shortconstrust} = "";
# recombinant construct の short expression
$this->{shortinsertion} = "";
# insertion を recombinant construct の short expres...
$this->{myhypertext} = ""; # ハイパーリンク付テキスト
}
# sub DESTROY{
# my $this = shift;
#
# print "DESTROY\n";
# }
sub copy{
#バグを修正(誤:=>、正:=) 2015年 1月24日
my $this = shift;
if( @_ ){
my $mystr = shift;
$this->{mytext} = $mystr->mytext();
$this->{category} = $mystr->category();
$this->{ishyperlink} = $mystr->ishyperlink();
$this->{withoutidentifier} = $mystr->withoutidentifie...
$this->{insertionidentifier} = $mystr->insertionidentif...
$this->{shortconstrust} = $mystr->shortconstrust();
$this->{shortinsertion} = $mystr->shortinsertion();
$this->{myhypertext} = $mystr->myhypertext();
}
return $this;
}
sub mytext{
my $this = shift;
# mytextが更新されたら、ほかの情報を初期化し処理し直す
$this->initialize();
if( @_ ){
$this->{mytext} = shift;
$this->generatehypertext();
}
return $this->{mytext};
}
sub category{
my $this = shift;
if( @_ ){
$this->{category} = shift;
}
return $this->{category};
}
sub ishyperlink{
my $this = shift;
if( @_ ){
$this->{ishyperlink} = shift;
}
return $this->{ishyperlink};
}
sub withoutidentifier{
my $this = shift;
if( @_ ){
$this->{withoutidentifier} = shift;
}
return $this->{withoutidentifier};
}
sub insertionidentifier{
my $this = shift;
if( @_ ){
$this->{insertionidentifier} = shift;
}
return $this->{insertionidentifier};
}
sub shortconstrust{
my $this = shift;
if( @_ ){
$this->{shortconstrust} = shift;
}
return $this->{shortconstrust};
}
sub shortinsertion{
my $this = shift;
if( @_ ){
$this->{shortinsertion} = shift;
}
return $this->{shortinsertion};
}
sub myhypertext{
my $this = shift;
if( @_ ){
$this->{myhypertext} = shift;
}
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
return $this->{myhypertext};
}
sub printtext{
my $this = shift;
print $this->{mytext};
}
sub printhypertext{
my $this = shift;
# 一々動かすのは無駄だけど、一回ずつ作り直すことにする
# テストくらいしか使わないだろうし
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
print $this->{myhypertext};
}
# ハイパーテキストを作る
# 遺伝子記号、挿入、バランサー、染色体異常で少しずつ異な...
sub generatehypertext{
my $this = shift;
$this->processmytext();
$this->{myhypertext} = ""; # 先にデータがあっても消す
if ( !($this->{ishyperlink}) ){
# ハイパーテキストを作らないときは、テキストをしまっ...
$this->{myhypertext} .= $this->{mytext};
} else {
$this->{myhypertext} .= "<a href=\"";
if( $this->{category} eq "gn"){
# 遺伝子記号のときは、allele をカットしてリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->dropallele( $this->{mytext} ),
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} elsif( $this->{category} eq 'tp'){
# 挿入のときは、
# 1.コンストラクトへのリンク
# 2.挿入そのもの(identifier含めて)へのリンク
# を作る
# コンストラトは「short」のタイプにしないとFlyBaseは返...
$this->{myhypertext} .=
$this->makelink(
$this->{shortconstrust},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{withoutidentifier};
$this->{myhypertext} .= "</a>";
# ショウジョウバエ遺伝資源センター特有の事情で……
# l(2)k**** にはallele名がない系統がある
# FlyBase には、それは、l(2)k****[*****] とinsertion
# identifier と allele名が同じものとして登録されて...
# だが、全て確認した訳ではない
# そこで、そのようなinsertion identifier
# ($noinsertioninfbti にリスト:insertion identifi...
# 頭一致)、かつ、allele名がない場合(「[」と「]」...
# 揃っていない場合)は、挿入としてではなく、遺伝子...
# ンクし、FlyBaseへのリンクでエラーがないように修正...
# insertionidentifier が遺伝子名
# l(2)k****[*****] のように insertion identifier を...
# 入へリンクもできるが、遺伝子へのリンクがより適切...
# 2015年 1月24日
my $listsymbolnumber = scalar(@{$noinsertioninfbti});
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i+...
if( (index($this->{insertionidentifier},
@{$noinsertioninfbti}[$my_i] ) == 0 ) &&
!((index($this->{insertionidentifier}, "\[") > 0) &&
(index($this->{insertionidentifier}, "\]") > 0) )
){
$this->{myhypertext} .= "<a href=\"";
$this->{myhypertext} .=
$this->makelink(
$this->{insertionidentifier},
"gn"
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{insertionidentifie...
$this->{myhypertext} .= "</a>";
return $this->{myhypertext};
}
}
if( $this->{insertionidentifier} ){
# identifierがない場合、当然リンクは作らない
$this->{myhypertext} .= "<a href=\"";
$this->{myhypertext} .=
$this->makelink(
$this->{shortinsertion},
"ti"
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{insertionidentifier};
$this->{myhypertext} .= "</a>";
}
} elsif( ($this->{category} eq "ba") ||
($this->{category} eq "ab") ) {
# バランサーと染色体異常のときは、そのままリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->{mytext},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} else{
# その他は存在させないが原則だが、
# 念のため、リンクなしを作るようにしておく
$this->{myhypertext} = $this->{mytext};
# 意識してドットなしイコールにしているので注意
}
}
return $this->{myhypertext};
}
# sub generatehypertextで使うサブルーチン
sub processmytext{
my $this = shift;
$this->whichcateogry();
# $this->{category} = "gn";
# $this->{category} = "tp";
# $this->{category} = "ab";
# $this->{category} = "ba";
# $this->{ishyperlink} = 1;
# $this->{ishyperlink} = 0;
if($this->{category} eq "tp"){
# 挿入のときは、道具を作っておく
$this->{withoutidentifier} = $this->makeswithoutident...
$this->{insertionidentifier} = $this->makesinsertionide...
$this->{shortconstrust} = $this->makeshortconstruc...
$this->{shortinsertion} =
$this->{shortconstrust} . $this->{insertionidentifi...
}
}
# 記号の種類を判断する
sub whichcateogry{
my $this = shift;
if( $this->isabberationnobalancer($this->{mytext}) ){
# 染色体異常であってバランサーでないもの(ポジティブ...
# 2015年 1月24日
$this->{category} = "ab";
$this->{ishyperlink} = 1;
} elsif( $this->isbalancer($this->{mytext}) ){
# バランサーを判断する 2015年 1月24日
# P{***} の名前を持つバランサーがあるなどへも対応で...
# バランサー:指定しているもののみ
$this->{category} = "ba";
$this->{ishyperlink} = 1;
} elsif( index($this->{mytext}, "(") > 0 ) {
# 染色体異常を判断する 2015年 1月24日
# 染色体異常は「(」を含むが
# 「l(2)」などではない($nonabberation に遺伝子記号...
$this->{category} = "ab";
my $listsymbolnumber = scalar(@{$nonabberation});
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( (index($this->{mytext},'{') > 0) ){
# 「{」があれば挿入、要リンク # 2015年 1月24日追加
$this->{category} = "tp";
$this->{ishyperlink} = 1;
}elsif( index($this->{mytext},
@{$nonabberation}[$my_i] ) >= 0 ){
$this->{category} = "gn";
$this->{ishyperlink} = 1; # 2015年 1月24日追加
}
}
} elsif( (index($this->{mytext},'{') > 0) ){
# 「{」があれば挿入、要リンク
$this->{category} = "tp";
$this->{ishyperlink} = 1;
} elsif( $this->isnolink($this->{mytext}) ){
# リンク不要の記号
$this->{ishyperlink} = 0;
# } else {
} elsif( $this->{ishyperlink} ) {
# デフォルトはリンク要
# 上で判断できなかったものは遺伝子記号としてリンクを...
$this->{category} = "gn";
$this->{ishyperlink} = 1;
# 結果として、わけのわからないものが遺伝子記号としてリ...
# る可能性がある
}
}
# バランサーか否かを判断する
sub isbalancer{
my $this = shift;
my $mysymbol = $_[0];
my $listsymbolnumber = scalar(@{$balancersymbols});
my $my_i = 0;
# $balancersymbols に含まれていたら、バランサーでは...
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ : EXPRがRE(正規表現で)
# 含まれると 1 を返すので if 内で正偽の判断ができる
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$balancersymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# 染色体異常であってバランサーでないものを判断する
# 2015年 1月24日
sub isabberationnobalancer{
my $this = shift;
my $mysymbol = $_[0];
my $listsymbolnumber = scalar(@{$abberationnonbalanc...
my $my_i = 0;
# 染色体異常であってバランサーでないものを検査
# eq を使って完全一致のみで判断
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol eq @{$abberationnonbalancer}[$my_i] ){
return 1;
}
}
return 0;
}
# リンク不要かどうか判断する
# 注意!不要なら「1」を返す
sub isnolink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $listsymbolnumber = 0;
my $my_i = 0;
# 全くリンクしないもの
$listsymbolnumber = scalar(@{$nolinksymbols_perfect});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol eq @{$nolinksymbols_perfect}[$my_i] ){
return 1;
}
}
# 正規表現で検査する前に、
# 最後のひと文字がコンマなどのときはカットしておく
# 最初のひと文字がコンマなどのときはカットしておく #...
$listsymbolnumber = scalar(@{$nolinksymbols_separate...
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最後のひと文字は念のため2度繰り返しておく 「(or?)...
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最初のひと文字が丸括弧などのときはカットしておく #...
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, 0, 1) eq
@{$nolinksymbols_separater}[$my_i] ){
$mysymbol =~ s/^.//;
}
}
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ : EXPRがRE(正規表現で)
# 含まれると 1 を返すので if 内で正偽の判断ができる
$listsymbolnumber = scalar(@{$nolinksymbols});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$nolinksymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# リンク文字列を作成する
# URLを返すだけ
sub makelink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $mycategory = $_[1]; # 可読性のため
my $temp = "";
$temp .= $hypertext1;
$temp .= $mycategory;
$temp .= $hypertext2;
# 最後のひと文字がコンマなどのときはリンク文字列から...
my $listsymbolnumber = scalar(@{$nolinksymbols_separ...
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最後のひと文字は念のため2度繰り返しておく 「(or?)...
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, -1 , 1) eq
@{$nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# 最初のひと文字が丸括弧などのときはカットしておく
# 2015年 1月24日追加
for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++...
if( substr($mysymbol, 0, 1) eq
@{$nolinksymbols_separater}[$my_i] ){
$mysymbol =~ s/^.//;
}
}
$temp .= uri_escape($mysymbol);
# uri_escapeを追加 query に使う遺伝子記号などをエス...
return $temp;
}
# 挿入の記号から、identifierを取り除く
sub makeswithoutidentifier{
my $this = shift;
my $lastparen = rindex($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},0,($lastparen+1));
return $temp;
}
# 挿入の記号から、identifierだけを返す
sub makesinsertionidentifier{
my $this = shift;
my $lastparen = index($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},($lastparen+1));
return $temp;
}
# 挿入の記号から、shortのconstructを作る
sub makeshortconstruct{
my $this = shift;
my $firstparen = index($this->{mytext},'{');
my $lastequal = rindex($this->{mytext},'=');
my $lastparen = 0;
my $temp = "";
$temp .= substr($this->{mytext},0,($firstparen+1));
if($lastequal<0){
# もともと short のときは元に戻るように細工しておく
$lastequal = $firstparen;
}
$temp .= substr($this->{mytext}, ($lastequal+1));
$lastparen = index($temp,'}');
$temp = substr($temp, 0, ($lastparen+1));
return $temp;
}
# allele の部分([と]で囲まれた部分)を削る
# そのようなものがなければ(表記としてはヘンなのだが)、
# 当然そのままにしておく
sub dropallele{
my $this = shift;
my $myparam = $_[0]; # 可読性のため
my $myfirst = rindex($myparam,'[');
if($myfirst>0){
return substr( $myparam, 0, $myfirst);
} else {
return $myparam;
}
}
# 「Class」 定義ここまで
#
########################################################...
**出力例&サンプル [#p63cf8fc]
出力例 → [[こちら>http://www.cis.kit.ac.jp/~tomaru/pukiwi...
パッチ入り → &ref(link_to_flybase20180419.zip);~
//ドラッグ&ドロップで使えるもの(サンプル入り) → &ref(l...
古いものも残しおきます。
深い意味はありません。
|Today:&counter(today);|Yesterday:&counter(yesterday);|To...
ページ名: