系統の遺伝子型から FlyBase へのリンクを作る perl プログラム 11 May 2010 †

ショウジョウバエ遺伝資源センターでは系統リスト （http://kyotofly.kit.jp/stocks/）の遺伝子型から FlyBase へリンクを張っています。 ですが、現在は遺伝子記号（gene symbol）に対してのみしかできていません。 そこで、もう少し「上手に」リンクを張るために遺伝子型から リンクを作成するperlのサンプルプログラムを作成しました。 もう少ししたらこれと同じような仕様に変わるでしょう。 実運用に使われるかどうかはわかりません*1。 ま、とにかく動けばいいのです。

以下の perlスクリプトは、テスト用に html ファイルを stdout に出力します。 プログラムはあまり時間を掛けずに書いたので （一晩でと言いたいところですが、もう少しかかってしまいました）、 ボロがあると思います。 今見ると直したい気になるが、ま、いっか*2*3。

↑

2015年1月15日追加 †

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);

の部分（もう１行おまじないもあります）。エスケープ結果は、正しく

P%7B3%27.RS5%2B3.3%27%7D

となりました。

近く実装の予定。

↑

2015年1月24日追加、更新、バグフィクス †

遺伝子記号などをパーセントエンコードするようにしたので（1月15日）、 基本的には全ての記号を FlyBase へリンクできるようになった。

そこで、 バランサーのリストの更新、 染色体異常の例外リスト更新、 ショウジョウバエ遺伝資源センター特有の事情となるかもしれない、挿入因子 の insertion identifier の FlyBase との不一致 への対応を行った。

また、strict、warnings により文法のチェックを行い、文法により厳密に従った。 実運用では、万が一のエラーを回避するため、strict と warnings はコメント アウトするといいかもしれない。

今後は、

目出つ更新は下のようなもの。

近く実装の予定。

↑

2018年4月19日 FlyBase のリンク方法変更への対応 †

FlyBase へのリンク方法が変更されていました。
FlyBase のドキュメント （FlyBase:Links to and from FlyBase） を読んでも埒が明かないので、ヘルプフォームから尋ねたところ、速攻で（20分後！）返事をいただきました。
今回は３年前の３分の１の間隔。インディアナは時差14時間だけど、いつ寝てるんだ、Josh Goodman さん？

その結果

を教えていただきました。

これまで（遺伝子記号 w の検索の例）

http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=SYN&db=fbgn&caller=quicksearch&context=w

現在

http://flybase.org/search/symbol/FBgn/w

これは「おまじないの方法」（あちらの受け入れるリンク方法）が変わっただけなので、 perl プログラムはそこだけ変更。実質２行だけ。
zipファイル（filelink_to_flybase20180419.zip）には

を入れています。

実装済みです。

↑

方針は下のとおり †

↑

１．FlyBase へのリンク †

our $hypertext1 = "http://flybase.org/search/symbol/FB";
#our $hypertext1 = "http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=SYN&db=fb";
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
	    # fbgn 遺伝子記号
	    # fbtp 組換えトランスポゾン
	    # fbti 挿入
	    # fbba バランサー
	    # fbab 染色体異常
our $hypertext2 = "/";
#our $hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ

2018年4月19日修正

↑

２．クエリー文字列は例外を除き、下のようなものに †

↑

３．遺伝子型から遺伝子記号、組換えコンストラクト、挿入、バランサー、染色体異常を判断する方法 †

(['Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc', 'Bascy',
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Biny',
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', 'CyO', 'DcxF',
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS5',
'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\.\+t38\}attPY',
'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', 'finscy',
'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', 'Payne',
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\.ftz-lacZ',
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;1\)y\[',
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(2\;3\)Q-2-w',
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]\.DcIV']);

（2015年 1月24日 更新）
FlyBase にある balancer を全て網羅 （FBba.xml.gz, FB2014_06, released November 12th, 2014）。 正規表現で利用

 染色体異常ではない記号（$nonabberation）：例示（ポジティブリスト）ではじまるもの
([ '3Cy(', 'En(', 'Hto-WP(', 'Ifm(', 'M(', 'MENE(', 'Ms(', 'Mu(',
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'acd(', 'dil(',
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', 'l(', 'mat(',
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', 'pc(',
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', 'tu(', 'v(',
# 後方互換性のため：前回（25 April 2010）はあって、今回（24 January
# 2015）は FlyBase に見つからなかったもの（↓）
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c(', 'ifm(',
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod(' ]);

（2015年 1月24日 更新）
FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記号を 全てチェックした。index で有無と位置を調べる。

 バランサーではなく染色体異常である記号（$abberationnonbalancer）：例示（ポジティブリスト）
(['FM7']);

（2015年 1月24日 追加*4）

(['l(2)k'])

（2015年 1月24日 追加）

ポジティブリスト方式は漏れが出やすいので避けたい。 その結果、わけのわからないものが遺伝子記号としてリンクされる可能性がある。 しかし、このような、 ポジティブリスト方式を取らずに自動でリンクを作る方法では解決策がない。

↑

４．リンクの例外（ネガティブリスト） †

運用してみて、多少の修正が必要かも（2015年 1月24日 更新）

↑

５．系統の遺伝子型を遺伝子記号等に分解する方法の修正 †

↑

６．遺伝子型ではなく、「series」で判断して、リンク不要のもの*5 †

↑

perl スクリプト †

コードは少しオブジェクト指向にしてしまいました。 こういう場合、構造化プログラミングよりも オブジェクト指向プログラミングが適しているので。 とはいえ、perlでオブジェクト指向はほぼ初心者なので幼稚な感じのはず。

プログラムを学んだ時期の手法（ANSI C 2.0、ANSI C++策定直前）が ぼくにとっては一番作り易いので、 「少し」という程度のオブジェクト指向 （構造体に関数が入っている程度のClass）です。

動作確認はウィンドウズ用のActivePerlのみで行いました。

［更新 19 April 2018］［更新 13 & 24 January 2015］［追記 16 May 2010］

#!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 http://www.ActiveState.com
# Built Jan 27 2010 14:12:21
# 
# Perl may be copied only under the terms of either the Artistic License or the
# GNU General Public License, which may be found in the Perl 5 source kit.
# 
# Complete documentation for Perl, including FAQ lists, should be found on
# this system using "man perl" or "perldoc perl".  If you have access to the
# Internet, point your browser at http://www.perl.org/, the Perl Home Page.
# ---------------------------------------------
#
# 現時点で GPL（GNU General Public License）を宣言すると
# 困る人が出る可能性があるので著作権は主張しておきます 都丸雅敏
# 
# このプログラムの作成にあたっては、文法書の類を参照しただけで
# ほかの人の作ったプログラムの流用はしていません
# なお、クラス化［オブジェクト指向化］部分はまねしたものがあります
# 具体的には、
#    my $this = shift;
# こうするといい、とか
#    bless $mystr, $this; ← コンストラクタの部分
# こうしないとインスタンスができない、とか
# 
# FlyBase へのリンクは、現行のものを使いましたが
# これは著作権云々に当たらない部分なので問題なしと考えます
# 
########################### 
# 
# 2015年 1月24日の修正
#
#  今後は、染色体異常ではない記号（$nonabberation）とバランサーではなく
#  染色体異常である記号（$abberationnonbalancer）、バランサー
#  （$balancersymbols）、FlyBaseへの挿入としてのリンクがinsertion
#  identifier を使ってでは上手くいかない記号（$noinsertioninfbti：
#  insertion identifier の行頭一致）の４つのリストをメンテナンスすれば
#  いいはず
#
#  $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, 2014）を利用
#
#
# ・FlyBase への検索クエリーで、検索する遺伝子記号などはパーセントエン
#   コードすることにした
# 
#  - uri_escape() （use URI::Escape;）を利用し % encode
#
#  - 検索する遺伝子記号などを % encode するように変更したことに伴い、リ
#    ンクしない記号（$nolinksymbols）の一部削除
#
#
# ・遺伝子記号の種類の判断を行う package MyString の sub whichcateogry
#   を修正
#
#  - 染色体異常を判断するロジックのバグを修正
# 
#  - バランサーではなく染色体異常である記号（ポジティブリスト）
#    （$abberationnonbalancer）の新設に対応し、判断を一番最初に行うこと
#    にした
#
#  - バランサー（$balancersymbols）の更新に対応し、バランサーの判断をバ
#    ランサーではなく染色体異常である記号（ポジティブリスト）の次に行う
#    ことにした
# 
#  - 染色体異常の判断ロジックのバグ修正、および染色体異常ではない記号
#    （$nonabberation）の更新に対応し、染色体異常の判断をバランサーの判
#    断の次に行うことにした
#
#
# ・ハイパーリンクを作成する package MyString の sub generatehypertext
#   を修正
#
#  - allele名がないが、 identifierが P{lacW}l(2)k**** への対応
#    ショウジョウバエ遺伝資源センター特有の事情
#    l(2)k**** にはallele名がない系統がある
#    FlyBase には、それは、l(2)k****[*****] とinsertion identifier と
#    allele名が同じものとして登録されているようだが、全て確認した訳では
#    ない
#    そこで、そのようなinsertion identifier （$noinsertioninfbti にリス
#    ト：insertion identifier の行頭一致）、かつ、allele名がない場合
#    （「[」と「]」の両方が揃っていない場合）は、挿入としてではなく、遺
#    伝子としてリンクし、FlyBaseへのリンクでエラーがないように修正する
#    l(2)k****[*****] のように insertion identifier を作り、挿入へリン
#    クもできるが、遺伝子へのリンクがより適切と考えた
# 
# 
# ・strict および warnings を使い、警告の出ないように文法の厳格化
# 
#  - グローバル変数に our、ローカル変数に my を全て付けた
#    $main::hogehoge で呼び出す必要がなくなったので、「$main::」を削除
#
#  - package MyString の sub copy のバグを修正（誤：=>、正：=）
# 
# 
###############################################################
# 定数定義
#
# FlyBase へリンクするためのおまじないの変更 2018年4月19日
# 下のような返信をいただいたので
#
# From: Josh Goodman <*******@indiana.edu>
# Subject: Re: FB Help Mailer: 1239 Searches (problem or question)
# Date: Thu, 19 Apr 2018 03:27:35 +0000
#
# （略）
#
# > The equivalent URL for
# > http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=SYN&db=fbgn&caller=quicksearch&context=w
# > 
# > 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?species=Dmel&field=SYN&db=fb";
# 上と下の間に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(', 'Mu(',
'P(', 'PL(', 'RD(', 'Rst(', 'S(', 'Su(', 'Z(', 'a(', 'acd(', 'dil(',
'E(', 'e(', 'fl(', 'fms(', 'fs(', 'gl(', 'gs(', 'im(', 'l(', 'mat(',
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'msd(', 'pc(',
'pre-mod(', 'r(', 'ref(', 'rk(', 'sens(', 'sl(', 'ss(', 'tu(', 'v(',
# 後方互換性のため：前回（25 April 2010）はあって、今回（24 January
# 2015）は FlyBase に見つからなかったもの（↓）
'Fs(', 'MNPV(', 'NPV(', 'anon-F117(', 'anon-atl149(', 'c(', 'ifm(',
'm(', 'ms(', 'rK(', 's(', 'su(', 'Mod('
]);
# index で有無と位置を調べる
# 「(」を含む遺伝子記号
# FlyBase (gene_map_table_fb_2014_06.tsv) にある遺伝子記号を
# 全てチェックした 24 January 2015
# 前回の調査（25 April 2010）のときには FlyBase、またはショウジョウバエ
# 遺伝資源センターの系統 にあって、今回の FlyBase のみの調査（24
# January 2015）では見つからなかったものは、後方互換性のため残した。

# バランサー
our $balancersymbols = ([
#
'Ab\(2\;3\)Tell-P\{Winkelried\(-FRT\)\}',
'Ab\(2\;3\)Tell-P\{Winkelried\}D', 'AM1', 'asc', 'Basc', 'Bascy',
'Binsc', 'Binscop', 'Binscy', 'Binsinscy', 'Binsn', 'Biny',
'Bwinscy', 'Byron', 'C\(1\)RM-w\[\+\]8', 'C\(1\)DX-\w*',
'C\([2,3]\)EN-\w*', 'C\([2,3]\)EN\[+\]', 'ClB', 'CxD', 'CyO', 'DcxF',
'DcY', 'Df\(1\)X-1-Ste\[W12\]', 'Dp\(1\;Y\)y\[\+\]-P\{RS5',
'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\.\+t38\}attPY',
'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', 'finscy',
'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', 'Payne',
'Pm-DTS18', 'R\(1\)2-P\{CaSpeR\}SL-17C', 'R\(1\)w\[vC\]\.ftz-lacZ',
'RS5W1', 'SD-\w*', 'SM[0-9]', 'TM[0-9]', 'TMS', 'Tp\(1\;1\)y\[',
'TSTL', 'TSTL14', 'T\(2\;3\)Su\(bw\[D\]\)5-bw\[\+\]',
'T\(2\;3\)V21-P\{lacW\}92E\.x3', 'T\(2\;3\)V21-Sb', 'T\(2\;3\)Q-2-w',
'T\(2\;3\)X2-7-w', 'T\(Y\;3\)x18\.\w', 'winscy', 'y\[+\]\.DcIV'
#
]); 
# FlyBase にある balancer を全て網羅
#（FBba.xml.gz、FB2014_06, released November 12th, 2014）
# 2015年 1月24日
# 正規表現で利用

# insertion identifier だけでは、FlyBase の insertion (fbti) にリストが
# ないもの（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->withoutidentifier(),
	    # 元々のコンストラクトで insertion identifier なし
	    "insertionidentifier" => $initMystr->insertionidentifier(),
	    # insertion identifier のみ
	    "shortconstrust"      => $initMystr->shortconstrust(),
	    # recombinant construct の short expression
	    "shortinsertion"      => $initMystr->shortinsertion(),
	    # insertion を recombinant construct の short expression で
	    "myhypertext"         => $initMystr->myhypertext()
	    # ハイパーリンク付テキスト
	    };
    }else{

	# デフォルトの初期化
    
	$mystr = {
	    "mytext"              => "",   
            # デフォルトは読み込んだ行は空の文字列
	    "category"            => "gn",    
	    # FlyBaseのdbのカテゴリ
	    # fbgn 遺伝子記号 allleへリンクはしない：デフォルト
	    # fbtp 組換えトランスポゾン
	    # fbti 挿入 tpとともに使う
	    # fbba バランサー 判断のためにリストを利用
	    # fbab 染色体異常 判断のためにリストを利用
	    #      FlyBaseが上手く返事を寄こさないものがあるので、NGリストも必要
	    "ishyperlink"         => 1,
	    # ハイパーリンクを作るか否か：デフォルト作る
	    "withoutidentifier"   => "",
	    # 元々のコンストラクトで insertion identifier なし
	    "insertionidentifier" => "", 
	    # insertion identifier のみ
	    "shortconstrust"      => "",
	    # recombinant construct の short expression
	    "shortinsertion"      => "",
	    # insertion を recombinant construct の short expression で
	    "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が上手く返事を寄こさないものがあるので、NGリストも必要
    $this->{ishyperlink} = 1;
    # ハイパーリンクを作るか否か：デフォルト作る
    $this->{withoutidentifier} = "";
    # 元々のコンストラクトで insertion identifier なし
    $this->{insertionidentifier} = ""; 
    # insertion identifier のみ
    $this->{shortconstrust} = "";
    # recombinant construct の short expression
    $this->{shortinsertion} = "";
    # insertion を recombinant construct の short expression で
    $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->withoutidentifier();
	$this->{insertionidentifier} = $mystr->insertionidentifier();
	$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'){
	# 挿入のときは、
	# １．コンストラクトへのリンク
	# ２．挿入そのもの（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 identifier の行
	    # 頭一致）、かつ、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->{insertionidentifier};
		    $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->makeswithoutidentifier();
	$this->{insertionidentifier} = $this->makesinsertionidentifier();
	$this->{shortconstrust}      = $this->makeshortconstruct();
	$this->{shortinsertion}      = 
	    $this->{shortconstrust} . $this->{insertionidentifier};
    }
}


# 記号の種類を判断する
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(@{$abberationnonbalancer});
    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;
	}
    }

    # 正規表現で検査する前に、
    # 最後のひと文字がコンマなどのときはカットしておく
    # 最初のひと文字がコンマなどのときはカットしておく # 2015年 1月24日追加
    $listsymbolnumber = scalar(@{$nolinksymbols_separater});
    for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
	if( substr($mysymbol, -1 , 1) eq 
	    @{$nolinksymbols_separater}[$my_i] ){
	    chop($mysymbol);
	}
    }
    # 最後のひと文字は念のため２度繰り返しておく 「(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/^.//;
	}
    }


    # 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_separater});
    for(my $my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
	if( substr($mysymbol, -1 , 1) eq 
	    @{$nolinksymbols_separater}[$my_i] ){
	    chop($mysymbol);
	}
    }
    # 最後のひと文字は念のため２度繰り返しておく 「(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 に使う遺伝子記号などをエスケープ 2015年1月13日

    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」 定義ここまで
# 
######################################################################
↑

出力例＆サンプル †

出力例 → こちら
パッチ入り → filelink_to_flybase20180419.zip
古いものも残しおきます。 深い意味はありません。

Today:2Yesterday:0Total:6092 since 11 May 2010
*1 実装されました
*2 がしかし、今日、バグを見つけ修正。690行目 誤： $Lastparen → 正： $lastparen
*3 更に、修正 sub whichcateogry の中の 最後のif 文 12 May 2010
*4 FM7はバランサーではない。バランサーはFM7cなど「7」の後にアルファベットが付く。FM1などはバランサーなのに……。何とややこしいことか。
*5 この perl スクリプトには含まれません。データ内容を知らないと意味不明と思います。FlyTrap は遺伝子型を正しく書き換えた後リンクするよう変更しました。W は野生型、nonmel はキイロショウジョウバエではない場合
添付ファイル: filelink_to_flybase20180419.zip 330件 [詳細] filelink_to_flybase_out20180419.html 488件 [詳細] filelink_to_flybase20150124.zip 334件 [詳細] filelink_to_flybaseout20150124.html 595件 [詳細] filelink_to_flybase_out20150115.html 572件 [詳細] filelink_to_flybase20150115.zip 258件 [詳細] filelink_to_flybase_out.html 1133件 [詳細] filelink_to_flybase.zip 922件 [詳細]
トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 23 Apr 2018 (月) 14:37:38 (2192d)