Commit f43d8474 authored by luc.moulinier's avatar luc.moulinier

refonte de IDMapping

parent df2b88d0
......@@ -1593,7 +1593,7 @@ proc SetupPDBObject {} {
oo::define Structure method surface {obj} {
set obj [BonObjName $obj]
my variable $obj ChnIdn ResSel db
dict set $obj surface [array get ResSel]
$db eval "update $obj set surface = 1 where ribbon=1 or catrace=1 or atoms=1 or cpk=1 or pearl=1"
......@@ -1607,7 +1607,6 @@ proc SetupPDBObject {} {
oo::define Structure method assignSelection {obj Lsel} {
set obj [BonObjName $obj]
my variable $obj ResSel ChnIdn db
#global db
set nom [string range [self] 2 end]
array set TSel $Lsel
......@@ -2089,7 +2088,7 @@ proc SetupPDBObject {} {
# Recupere atomes contribuant a la surface
set Lva {}
e$db eval "select a.x, a.y, a.z, a.na from atoms as a, $obj as o where a.pk_atoms = o.pk_obj and o.surface=1" {lappend Lva [list $x $y $z $na 1]}
$db eval "select a.x, a.y, a.z, a.na from atoms as a, $obj as o where a.pk_atoms = o.pk_obj and o.surface=1" {lappend Lva [list $x $y $z $na 1]}
set Lva [lsort -unique $Lva]
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly -filter 13 $Lva] Lv Ln
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly $Lva] Lv Ln
......@@ -2484,7 +2483,7 @@ proc SetupPDBObject {} {
# Trace le RIBBON
if {[dict get [set $obj] FlagRib]} {
set LesVecs [list]
set LesVecs {}
foreach chn $ChnIdn {
set ListeLat [my _AtomesDuRibbon $obj $chn]
if {$ListeLat == 0} {continue}
......
......@@ -13465,3 +13465,15 @@ proc nico_img {args} {
return
}
proc cherie {} {
set Lid [LesLignesDuFichier ~/lae.txt]
#set Lid [LesLignesDuFichier ~/l.txt]
set res [eFetchREST protein [join $Lid ,]]
set Lembl [SplitLesEMBL $res]
puts "[llength $Lembl]"
return
}
......@@ -400,14 +400,23 @@ proc TestPckFastme {aT} {
}
proc EcritTableDistances {aT f} {
upvar $aT T
proc WriteDistanceTable {f {aT ""}} {
if {$aT ne ""} {
upvar $aT T
} else {
array set T [array get ::TDesPCI]
}
set foo [open $f w]
set foo [CheckOpen $f]
if {$foo eq ""} {
FaireLire "Warning !\nUnable to open file >$f< for writing. Please check permissions."
return
}
set Ln [array names T]
foreach e $Ln {
set Le [join [split $e ,]]
set Le [split $e ,]
lappend Lnom {*}$Le
}
set Lnom [lsort -unique $Lnom]
......
......@@ -3162,5 +3162,12 @@ proc lslr {} {
exit
}
if {0} {
cheque : agence comptable
agence comptable
Institut Le Bel
4 rue Blaise Pascal
67 000 Strasbourg
}
#
##
# ordali_service.tcl
#
proc jtd {Lacc BankSource BankTarget source target} {
set cmd "select $source,$target from $BankSource where $source in ('[join $Lacc ',']')"
return $cmd
}
proc jtD {Lacc BankSource BankTarget source target} {
AttachIDMappingBank ACC2ACC
#lulu
set cmd "select db1.$source,db2.acc from $BankSource as db1, ACC2ACC as db2 where db1.$source in ('[join $Lacc ',']') and db1.acc = db2.id"
return $cmd
}
proc jTd {Lacc BankSource BankTarget source target taxid} {
AttachIDMappingBank NCBI_TAXID
set cmd "select db1.$source,db1.$target from $bank as db1, NCBI_TAXID as db2 where db1.$source in ('[join $Lacc ',']') and db2.id='$taxid' and db1.acc = db2.acc"
return $cmd
}
proc jTD {Lacc BankSource BankTarget source target taxid} {
AttachIDMappingBank NCBI_TAXID
AttachIDMappingBank ACC2ACC
set cmd "select db1.$source,db3.acc from $bank as db1, NCBI_TAXID as db2, ACC2ACC as db3 where db1.$source in ('[join $Lacc ',']') and db2.id='$taxid' and db1.acc = db2.acc and db1.acc = db3.acc"
return $cmd
}
proc Jtd {Lacc BankSource BankTarget source target} {
AttachIDMappingBank $BankTarget
set cmd "select db1.id, db2.id from $BankSource as db1, $BankTarget as db2 where db1.id in ('[join $Lacc ',']') and db1.acc = db2.acc"
return $cmd
}
proc JtD {Lacc BankSource BankTarget source target} {
AttachIDMappingBank $BankTarget
AttachIDMappingBank ACC2ACC
set cmd "select db1.id,db3.id from $BankSource as db1, ACC2ACC as db2, $BankTarget as db3 where db1.id in ('[join $Lacc ',']') and db1.acc = db2.acc and db2.id = db3.acc"
return $cmd
}
proc JTd {Lacc BankSource BankTarget source target taxid} {
AttachIDMappingBank $BankTarget
AttachIDMappingBank NCBI_TAXID
set cmd "select db1.id, db2.id from $BankSource as db1, $BankTarget as db2, NCBI_TAXID as db3 where db1.id in ('[join $Lacc ',']') and db3.id = '$taxid' and db1.acc = db2.acc and db1.acc = db3.acc"
return $cmd
}
proc JTD {Lacc BankSource BankTarget source taxid} {
AttachIDMappingBank $BankTarget
AttachIDMappingBank NCBI_TAXID
AttachIDMappingBank ACC2ACC
set cmd "select db1.id, db2.id from $BankSource as db1, $BankTarget as db2, NCBI_TAXID as db3, ACC2ACC as db4 where db1.id in ('[join $Lacc ',']') and db3.id = '$taxid' and db1.acc = db2.acc and db1.acc = db3.acc and db1.acc = db4.id"
return $cmd
}
proc AttachIDMappingBank {bank} {
set fdb [file join [idmHome] SQLDBS ${bank}.sql]
$::db eval {attach database $fdb as $bank}
return
}
proc OldIDMappingRequest {} {
if {0} {
puts "bank = $bank"
set db [DbIDMappingSQL $bank open]
if {! $jointure} {
if {$taxid eq ""} {
if {! $checkDashAcc} {
set cmd "select $source,$target from $bank where $source in ('[join $Lacc ',']')"
} else {
set fdb [file join [idmHome] SQLDBS ACC2ACC.sql]
$db eval {attach database $fdb as ACC2ACC}
#lulu
set cmd "select db1.$source,db2.acc from $bank as db1, ACC2ACC as db2 where db1.$source in ('[join $Lacc ',']') and db1.acc = db2.id"
}
} else {
# taxid = 1
set fdb [file join [idmHome] SQLDBS NCBI_TAXID.sql]
$db eval {attach database $fdb as NCBI_TAXID}
if {! $checkDashAcc} {
set cmd "select db1.$source,db1.$target from $bank as db1, NCBI_TAXID as db2 where db1.$source in ('[join $Lacc ',']') and db2.id='$taxid' and db1.acc = db2.acc"
} else {
# checkDashAcc = 1
set fdb [file join [idmHome] SQLDBS ACC2ACC.sql]
$db eval {attach database $fdb as ACC2ACC}
set cmd "select db1.$source,db3.acc from $bank as db1, NCBI_TAXID as db2, ACC2ACC as db3 where db1.$source in ('[join $Lacc ',']') and db2.id='$taxid' and db1.acc = db2.acc and db1.acc = db3.acc"
} ; # fin checkDashAcc
} ; # fin taxid
} else {
# jointure = 1
set fdb [file join [idmHome] SQLDBS ${to}.sql]
$db eval {attach database $fdb as $to}
if {$taxid eq ""} {
if {! $checkDashAcc} {
set cmd "select db1.id, db2.id from $from as db1, $to as db2 where db1.id in ('[join $Lacc ',']') and db1.acc = db2.acc"
} else {
set fdb [file join [idmHome] SQLDBS ACC2ACC.sql]
$db eval {attach database $fdb as ACC2ACC}
set cmd "select db1.id,db3.id from $from as db1, ACC2ACC as db2, $to as db3 where db1.id in ('[join $Lacc ',']') and db1.acc = db2.acc and db2.id = db3.acc"
} ; # checkDashAcc
} else {
# taxid = 1
if {! $checkDashAcc} {
# lulu
set fdb [file join [idmHome] SQLDBS NCBI_TAXID.sql]
$db eval {attach database $fdb as NCBI_TAXID}
set cmd "select db1.id, db2.id from $from as db1, $to as db2, NCBI_TAXID as db3 where db1.id in ('[join $Lacc ',']') and db3.id = '$taxid' and db1.acc = db2.acc and db1.acc = db3.acc"
} else {
# checkDashAcc = 1
} ; # fin checkDasshAcc
} ; # fin taxid
}
puts "\n$cmd"
set Lout [$db eval $cmd]
$db close
}
return
}
proc CreateIDMappingSQLRequest {Lacc bank BankSource BankTarget source target {taxid ""}} {
global db
set Join [expr {$BankSource ni {ACC ID ACC+ID} && $BankTarget ni {ACC ID}}]
set Taxo [expr {$taxid != ""}]
set Dash [expr {$BankSource in [ListOfDBsWithDashAccess] && $BankTarget ni [ListOfDBsWithDashAccess]}]
set db [DbIDMappingSQL $bank open]
if { ! $Join && ! $Taxo && ! $Dash } {
set cmd [jtd $Lacc $bank $BankTarget $source $target]
}
if { ! $Join && ! $Taxo && $Dash } {
set cmd [jtD $Lacc $BankSource $BankTarget $source $target]
}
if { ! $Join && $Taxo && ! $Dash } {
set cmd [jTd $Lacc $BankSource $BankTarget $source $Tax]
}
if { ! $Join && $Taxo && $Dash } {
set cmd [jTD $Lacc $BankSource $BankTarget $source $Tax]
}
if { $Join && ! $Taxo && ! $Dash } {
set cmd [Jtd $Lacc $BankSource $BankTarget $source $target]
}
if { $Join && ! $Taxo && $Dash } {
set cmd [JtD $Lacc $BankSource $BankTarget $source $target]
}
if { $Join && $Taxo && ! $Dash } {
set cmd [JTd $Lacc $BankSource $BankTarget $source $target $taxid]
}
if { $Join && $Taxo && $Dash } {
set cmd [JTD $Lacc $BankSource $BankTarget $source $Tax]
}
puts "\n$cmd\n"
set Lout [$db eval $cmd]
$db close
return $Lout
}
proc InitWebServices {} {
......@@ -665,13 +850,21 @@ proc IDMapping {from to LId {orga ""}} {
proc IDMapping_help {{args ""}} {
if {$args eq ""} {
puts "Usage : idmapping <from> <to> <ids list>"
if {$args eq "" || [string tolower $args] eq "help"} {
puts "\nUsage : \n\tidmapping <from> <to> <ids list> ?<taxid>?"
puts ""
puts ""
puts " <from> should be one of ACC, ACC+ID, ID or any of the available databasees."
puts " <to> should be one of ACC, ID or any of the available databases."
puts ""
puts " <from> should be one of ACC ID ACC+ID"
puts " OR "
puts " <to> should be one of ACC ID"
puts "To obtain the full list of dtabases, type :"
puts "\tIDMapping_help list"
} elseif {$args eq "ListOfBanks"} {
puts "\nList of available IDMapping Banks :"
puts "\n[join [ListOfAllIDMappingBanks] \n] \n"
puts ""
return
} else {
set Lsql [glob "*.sql"]
foreach b $Lsql {
......@@ -697,8 +890,28 @@ proc idmHome {} {
}
proc BICSDir {} {
if {[info exists env(BICSDIR)]} {
set BicsDir $env(BICSDIR)
} else {
set BicsDir /commun/bics
}
return $BicsDir
}
proc IDMappingDir {} {
return "/commun/bics/IDMapping/production/"
return [file join [BICSDir] IDMapping production]
}
proc ListOfDBsWithDashAccess {} {
if {! [info exists ::ListOfDBsWithDashAccess]} {
set ::ListOfDBsWithDashAccess [lsort [LesLignesDuFichier [file join [IDMappingDir] .. BanksWithDashAccess.dat]]]
}
return $::ListOfDBsWithDashAccess
}
......@@ -712,36 +925,44 @@ proc ListOfAllIDMappingBanks {} {
proc CheckIDMappingInputParam {args} {
# This proc is called when doing external call
# to IDMapping (setidmapping)
if {[llength $args] < 3} {
IDMapping_help
return
}
# parse arguments
lassign $args from to Lids taxid
if {$taxid != "" && ! [string is integer $taxid]} {
set from [string toupper $from]
set to [string toupper $to]
# if exits, taxid should be integer
if {$taxid ne "" && ! [string is integer $taxid]} {
puts "\nError !\n\ttaxID should be an integer !\n"
exit
}
set from [string toupper $from]
set to [string toupper $to]
set LidmDBs [ListOfAllIDMappingBanks]
lappend LidmDBs "ACC+ID" ACC ID
if {$from ni $LidmDBs || $to ni $LidmDBs} {
puts "\nError :\nBad <FROM_db> and/or <TO_db> names !"
puts "\nError :\nBad <FROM_db> and/or <TO_db> names !\n"
IDMapping_help
return
}
if {$to eq "ACC+ID"} {
puts "Bad value for <to> !\n"
IDMapping_help
return
}
#
# 1) check Aceessions data ...
# check list of IDse
if {[file exists $Lids]} {
set Ltmp [LesLignesDuFichier $Lids]
set Lids {}
foreach l $Ltmp {
if {[string trim $l] eq ""} {continue}
if {[string trim $l] eq ""} {
continue
}
set l [string toupper $l]
if {[regexp {\,| |\;|\|} $l]} {
set l [split $l " ,;|"]
......@@ -751,11 +972,9 @@ proc CheckIDMappingInputParam {args} {
} else {
# ids are not in a file
set Lids [string toupper $Lids]
if {[regexp { |\,|\;|\|} $Lids]} {
set Lids [split $Lids " ,;|"]
}
set Lids [CheckIdsAsList $Lids]
}
return [list $from $to $Lids $taxid]
}
......@@ -782,14 +1001,18 @@ proc DbIDMappingSQL {bank what} {
proc IDMapping_sql {from to Lids {taxid ""}} {
lassign [CheckIDMappingInputParam $from $to $Lids $taxid] from to Lids taxid
set Lacc {}
if {$from ni {ACC ID ACC+ID} && $to ni {ACC ID}} {
set jointure 1
set uniprotbank 0
} elseif {$from in {ACC ID ACC+ID} && $to in {ACC ID}} {
set jointure 0
set uniprotbank 1
} else {
set jointure 0
set uniprotbank 0
}
set Lacc {}
switch $from {
"ACC" {
set source acc
......@@ -800,18 +1023,14 @@ proc IDMapping_sql {from to Lids {taxid ""}} {
"ID" -
"ACC+ID" {
set source acc
if {0 && $to eq "ACC"} {
set bank ""
} else {
set bank $to
}
set bank $to
set target id
# get everything as an ACC
set db [DbIDMappingSQL UNIPROTKB_ID open]
set Laccid [$db eval "select acc,id from UNIPROTKB_ID where id in ('[join $Lids ',']') OR acc in ('[join $Lids ',']')"]
$db close
foreach {a i} $Laccid {
set t($a) $a
set t($i) $a
......@@ -835,50 +1054,33 @@ proc IDMapping_sql {from to Lids {taxid ""}} {
set Lacc $Lids
}
}
# idmapping inside UniProt itself
if {$bank eq ""} {
return $Lacc
}
if {$to eq "ACC"} {
set target acc
}
if {$to eq "ID" || $to eq "ACC"} {
if {$uniprotbank} {
set bank UNIPROTKB_ID
}
if {! $jointure} {
set db [DbIDMappingSQL $bank open]
if {$taxid eq ""} {
set cmd "select $source,$target from $bank where $source in ('[join $Lacc ',']')"
} else {
set fdb [file join [idmHome] SQLDBS NCBI_TAXID.sql]
$db eval {attach database $fdb as NCBI_TAXID}
set cmd "select db1.$source,db1.$target from $bank as db1, NCBI_TAXID as db2 where db1.$source in ('[join $Lacc ',']') and db2.id='$taxid' and db1.acc = db2.acc"
}
#
# on tient compte des access avec '-' que si :
# banque Dassh vess PAS dash
# id <-> accDash ::: acc <-> id
#
# dans autres cas, accDash pas grave
if {$from in [ListOfDBsWithDashAccess] && $to ni [ListOfDBsWithDashAccess]} {
set checkDashAcc 1
} else {
set db [DbIDMappingSQL $from open]
set fdb [file join [idmHome] SQLDBS ${to}.sql]
$db eval {attach database $fdb as $to}
if {$taxid ne ""} {
set fdb [file join [idmHome] SQLDBS NCBI_TAXID.sql]
$db eval {attach database $fdb as NCBI_TAXID}
set cmd "select db1.id, db2.id from $from as db1, $to as db2, NCBI_TAXID as db3 where db1.id in ('[join $Lacc ',']') and db3.id = '$taxid' and db1.acc = db2.acc and db3.acc = db2.acc"
} else {
set cmd "select db1.id, db2.id from $from as db1, $to as db2 where db1.id in ('[join $Lacc ',']') and db1.acc = db2.acc"
}
set checkDashAcc 0
}
set Lout [$db eval $cmd]
$db close
# create SQL request
set Lout [CreateIDMappingSQLRequest $Lacc $bank $from $to $source $target $taxid]
foreach {in out} $Lout {
lappend t($in) $out
}
set Lres {}
foreach a $Lacc {
if {[info exists t($a)]} {
......@@ -887,7 +1089,7 @@ proc IDMapping_sql {from to Lids {taxid ""}} {
lappend Lres ""
}
}
return $Lres
}
......@@ -1338,8 +1540,10 @@ proc FetchOneEBI {id} {
proc eFetchREST {db Lid {what ""}} {
package require TclCurl
package require http
package require tls
# part of eUtils service from NCBI.
#
# the type and format of returning data depends on
......@@ -1421,36 +1625,42 @@ proc eFetchREST {db Lid {what ""}} {
}
}
set paquets 200
set ni [expr {int([llength $Lid]/$paquets)+1}]
set Lres [list]
for {set i 0} {$i < $ni} {incr i} {
set d [expr {$i*$paquets}]
set f [expr {($i+1)*$paquets-1}]
set LidNow [lrange $Lid $d $f]
set Loptions [list \
db $db \
id [join $LidNow ,]]
if {$rettype ne ""} {
lappend Loptions rettype $rettype
}
if {$retmode ne ""} {
lappend Loptions retmode $retmode
if {[string first "," $Lid] > -1} {
set Lid [split $Lid ,]
}
set Lres ""
set Loptions [list db $db]
if {$rettype ne ""} {
lappend Loptions rettype $rettype
}
if {$retmode ne ""} {
lappend Loptions retmode $retmode
}
set Pack 10000
set nPacks [expr {int(1.0*[llength $Lid]/$Pack)}]
for {set i 0} {$i <= $nPacks} {incr i} {
set d [expr {$i * $Pack}]
set f [expr {($i + 1) * $Pack - 1}]
if {$f > [llength $Lid]} {
set f end
}
set query [::http::formatQuery {*}$Loptions]
set Lopt [list {*}$Loptions id [join [lrange $Lid $d $f] ,]]
set query [::http::formatQuery {*}$Lopt]
# HttpCopy returns a text string
package require TclCurl
if {[catch {set out [curl::transfer -followlocation 1 -url $url -bodyvar ddb -post 1 -postfields $query]}]} {
if {[catch {set out [curl::transfer -followlocation 1 -url $url -bodyvar ddb -post 1 -postfields $query]} Msg]} {
puts "Error while transfering data !"
puts "Msg :\n$Msg"
set ddb ""
}
#set ddb [HttpCopy $url "" $query]
if {$ddb eq ""} {
return ""
continue
}
switch $db {
"taxonomy" {
lappend Lres {*}[TaxonomyProcessXML $ddb $LidNow]
......@@ -1459,11 +1669,11 @@ proc eFetchREST {db Lid {what ""}} {
lappend Lres {*}[PubMedProcessXML $ddb $LidNow]
}
default {
lappend Lres $ddb
append Lres $ddb
}
}
}
return $Lres
}
......@@ -4003,3 +4213,18 @@ proc pl2 {} {
exit
}
proc tpl {} {
cd /commun/bics/IDMapping/production
set Lres {}
foreach bk [ListOfAllIDMappingBanks] {
set l [exec wc -l ${bk}.dat]
lappend Lres $bk [lindex [split $l] 0]
}
set Lres [lsort -stride 2 -index 1 -integer -increasing $Lres]
lmap {x y} $Lres {puts "$x $y"}
exit
}
......@@ -927,12 +927,12 @@ proc ChangeTkOptions {} {
option add *vdx.TCombobox*Listbox.foreground white
ttk::style configure vdx.TRadiobutton \
-background black \
-foreground white \
-relief flat \
-activebackground black \
-anchor w -justify left
-background black \
-foreground white \
-relief flat \
-activebackground black \
-anchor w -justify left
option add *nwoj.f.fsel.ctyp*Listbox.foreground white
option add *nwoj.f.fsel.ctyp*Listbox.background black
option add *nwoj.f.fpai.ctyp*Listbox.foreground white
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment