[Isis-fish-devel] interface R pour plotter les resultats d'isis-fish

6 Sep 2006

      re-bonjour,

J'ai oublié de dire que l'interface se lance sous R par:
...
interfaceExportFromIsis(TRUE)
Bonjour,

ci-joint : modification du script de l'interface R tenant compte des
dernières modifications du pack de gestion d'isis qui change la forme
des exports .csv.

ATTENTION: le package R 'tcltk2' est désormais requis pour lancer
l'interface-> il doit être installer dans R avant...

Bonjour à tous,

Pouvant en intéresser certains, vous trouverez ci-joint un script R très
simple qui permet de lancer une interface minimaliste pour générer à
partir des fichiers exports .csv d'isis-fish (générés par les scripts
d'Hilaire) tous les graphs que propose isis dans son interface (+
exactement pour l'instant les abondances, les captures, les efforts; une
ou deux lignes de code devront être ajoutées pour plotter d'autres données)

il faut simplement sourcer ce script sous R puis lancer la fonction
principale pour que l'interface s'ouvre. Par exemple:

source('Q:/sourcesR/ModelBrest/withFLFleet&Metiers/Isis-FLR-30Aug06-demo/exportFromIsis/interfaceExportFromIsisINDEPENDANT.r')
   interfaceExportFromIsis()

-- 
--------------------------------------------------------
François Bastardie

French Research Institute for the Development of the Sea (IFREMER)
Ecologie et Modèles pour l'Halieutique
Rue de l'Ile d'Yeu
BP 21105
44311 NANTES Cedex 03 - France
Tél : 02 40 37 41 64
Fax : 02 40 37 40 75
E-mail : francois.bastardie@ifremer.fr

#---------------------------------------------------------
#---------------------------------------------------------
# Plotting from Isis-Fish .csv export files in R console 
# using an R interface (tcltk tools).
# ***31 August 06***
# François Bastardie
# IFREMER, dep EMH, Nantes                                
#---------------------------------------------------------
#---------------------------------------------------------

# to launch this interface in independante way
# source this current script in a R session 
# and launch interfaceExportFromIsis(TRUE) function.

#------------------------------------
#------------------------------------
interfaceExportFromIsis <- function(INDEPENDANTE=FALSE)
{

require(tcltk)
require(tcltk2)
ttPlotIsis <<- tktoplevel(height =100,width =700)
tktitle(ttPlotIsis) <- "plotting from isis-fish"
fontHeading <- tkfont.create(family="arial",size=11)
fonttPlotIsisextLabel <- tkfont.create(family="arial",size=10)

# helpful information
scr <- tkscrollbar(ttPlotIsis, repeatinterval=5,
                       command=function(...)tkyview(txt,...))
txt <- tk2text(ttPlotIsis,bg="white",font="courier",height =5,width =80,yscrollcommand=function(...)tkset(scr,...))
tkgrid(txt,scr,columnspan=5)
tkgrid.configure(scr,sticky="ewns")
tkinsert(txt,"end","Plotting data from Isis-fish export .csv files:\nSet the path with your path, choose the year.dep in the 21th century, adapt the arguments using names of fleets, the type of data (CapturePoids, etc.) or TRUE/FALSE as needed (see 'args' fields) and tick the data you want to be plotted before clicking on OK button")
tkconfigure(txt, state="disabled")
tkfocus(txt)

   tkgrid(tk2label(ttPlotIsis,text=" "))
   tkgrid(tk2label(ttPlotIsis,text=" "))

listForPlotting <<-list()
a.vect <- c("namesim")          
if(INDEPENDANTE==FALSE)
for (rr in a.vect)
{ 
   if(!exists("aFileName")) tkmessageBox(title="error", message="you have to simulate or load an existing simulation...")  
   if(!is.null(aFileName)) {a <- unlist(strsplit(aFileName,split="/")); b<-  unlist(strsplit(a[length(a)],split=".",fixed=TRUE)) ; 
                           aText <<- b[2]}
   else aText <- as.character(namesim[length(namesim)])
   listForPlotting[[rr]] <<- tkentry(ttPlotIsis,width=40,textvariable=tclVar(aText))
   tkgrid(tk2label(ttPlotIsis,text="current isis-flr simulation"),listForPlotting[[rr]])

}

   tkgrid(tk2label(ttPlotIsis,text=" "))

# for setting the graph options
listOptionsPath<<-list(); exportPathFromIsis<<-NULL ;repository.name<<-NULL
listOptionsNumeric<<-list();year.dep <<-1 ;leg.location<<-1/4
aText7 <<- c("exportPathFromIsis","repository.name") 
aText8 <<- c("year.dep","leg.location") 
default.values7 <- c("Q:\\sourcesR\\ModelBrest\\withFLFleet&Metiers\\Isis-FLR-6Sep06\\output\\compareWithIsisFish\\",
                      "hake.ttesStrategiesWithSpain&hakeBox-jum&VHVO..-06_09_2006-1033\\") 
default.values8 <- c("1","1/4") 
for (hh in 1:length(aText7))
  {  
  listOptionsPath[[hh]] <<- tkentry(ttPlotIsis,width=50,textvariable=tclVar(default.values7[hh]))
  tkgrid(tk2label(ttPlotIsis,text=aText7[hh]),listOptionsPath[[hh]])
  }
for (hh in 1:length(aText8))
  {  
  listOptionsNumeric[[hh]] <<- tkentry(ttPlotIsis,width=50,textvariable=tclVar(default.values8[hh]))
  tkgrid(tk2label(ttPlotIsis,text=aText8[hh]),listOptionsNumeric[[hh]])
  }

   tkgrid(tk2label(ttPlotIsis,text=" ")) 
   tkgrid(tk2label(ttPlotIsis,text=" "))

listForPlotIsis <<-list() ; cbValForPlotIsis <<-list()

typeOfArgs <- c("aFleet=\"HakeLargeGuilvinec\" perFleet=TRUE typedata=\"CapturesPoids\" aStock=\"merluccius\" perAge=FALSE perZone=FALSE",
                "aStock=\"merluccius\" typedata=\"Biomasses\" perAge=FALSE perZone=FALSE perFleet=FALSE aFleet=\"all\"",
                "aStock=\"merluccius\" typedata=\"Biomasses\" perAge=TRUE perZone=FALSE perFleet=FALSE aFleet=\"all\"",
                "aStock=\"merluccius\" typedata=\"Abondances\" perAge=TRUE perZone=FALSE perFleet=FALSE aFleet=\"all\"",
                "aFleet=\"HakeLargeGuilvinec\" perFleet=TRUE typedata=\"EffortsMetier\" perAge=FALSE perZone=FALSE aStock=\"\""
                )
typeOfFunc <- c("plottingIsisExports",
                "plottingIsisExports",
                "plottingIsisExports",
                "plottingIsisExports",
                "plottingIsisExports"
               )

typeOfFunc <- unlist(strsplit(typeOfFunc," "))
it<-1

for (tof in 1 : length(typeOfFunc))
  {
  listForPlotIsis[[it]]   <<- tkentry(ttPlotIsis,width=30,text=tclVar(as.character(typeOfFunc[tof])))
  listForPlotIsis[[it+1]] <<- tkentry(ttPlotIsis,width=70,textvariable=tclVar(as.character(typeOfArgs[tof])))
  listForPlotIsis[[it+2]] <<- tk2checkbutton(ttPlotIsis)
  cbValForPlotIsis[[it]] <<-0;cbValForPlotIsis[[it+1]]<<-0;cbValForPlotIsis[[it+2]]<<- tclVar("0")

  tkconfigure(listForPlotIsis[[it+2]],variable=cbValForPlotIsis[[it+2]]) # indispensable!
  tkgrid(
         tk2label(ttPlotIsis,text=paste(" function:")),listForPlotIsis[[it]], 
         tk2label(ttPlotIsis,text=paste(" args:")),listForPlotIsis[[it+1]],
         tk2label(ttPlotIsis,text=paste(" enabled:")),listForPlotIsis[[it+2]]
         )

  it<-it+3
  }

   tkgrid(tk2label(ttPlotIsis,text=" "))
   tkgrid(tk2label(ttPlotIsis,text=" "))

OK.but <- tk2button(ttPlotIsis,    text="     OK   ",command=executePlotIsis)
Cancel.but <- tk2button(ttPlotIsis,text="   Cancel ",command=  function() tkdestroy(ttPlotIsis))
tkgrid(tk2label(ttPlotIsis,text=" "),tk2label(ttPlotIsis,text=" "),OK.but,Cancel.but)

tkfocus(ttPlotIsis)
 #tkwait.window(ttPlotIsis) 

return()
}

#---
executePlotIsis <- function()
   {
   tkfocus(ttPlotIsis)

     # eval plotting options (character)
     for (hh in 1 :length(aText7))                                       
     {
      #eval(parse("",text=paste(aText7[hh]," <<-  eval(parse(\"\",text=tclvalue(tkget(listOptionsPath[[hh]]))))"))) # assign new value as global
     eval(parse("",text=paste(aText7[hh]," <<-  as.character(tclvalue(tkget(listOptionsPath[[hh]])))"))) # assign new value as global
     }

       # eval plotting options (numeric)
     for (hh in 1 :length(aText8))                                       
     {
      eval(parse("",text=paste(aText8[hh]," <<-  eval(parse('',text=tclvalue(tkget(listOptionsNumeric[[hh]]))))"))) # assign new value as global
     }

   i<-1
   while ( i< length(listForPlotIsis)) # for each function 
    {
    if(as.character(tclvalue(cbValForPlotIsis[[i+2]]))=="1") # if the check button is enabled for this function...
       {
       func <- as.character(tclvalue(tkget(listForPlotIsis[[i]])))
       arguments <- as.character(tclvalue(tkget(listForPlotIsis[[i+1]])))
       arguments <- paste(unlist(strsplit(arguments," ")),collapse=",")
       print(arguments)
       eval(parse("",text=paste(func,"(",arguments,")")))
       }
    i <- i+3  
    } # end while  
    tkdestroy(ttPlotIsis)
   } 

#----------------------------------------
#----------------------------------------
#----------------------------------------
# fonction split du dataf en dataf par population (fonctionne pour capture ou abondance)
splitPop <- function (dataf,nomdudataf)
{
listPop <- unique(dataf$population)
#nomdudataf <- paste("dataf.",nom)
splitInPop.f <- function (i,ledataf,nomdudataf, listPop)
   {
   ledataf.pop <- ledataf[ledataf$population == listPop[i],]
   assign(paste(nomdudataf,".", as.character(listPop[i]),sep=""),ledataf.pop, env = .GlobalEnv)
   }
lapply(1:length(listPop), splitInPop.f, dataf, nomdudataf, listPop)
}

#----------------------------------------
# fonction split du dataf en dataf par population (fonctionne pour capture ou abondance)
splitPop <- function (dataf,nomdudataf)
{
listPop <- unique(dataf$population)
#nomdudataf <- paste("dataf.",nom)
splitInPop.f <- function (i,ledataf,nomdudataf, listPop)
   {
   ledataf.pop <- ledataf[ledataf$population == listPop[i],]
   assign(paste(nomdudataf,".", as.character(listPop[i]),sep=""),ledataf.pop, env = .GlobalEnv)
   }
lapply(1:length(listPop), splitInPop.f, dataf, nomdudataf, listPop)
}

#----------------------------------------
# fonction split du dataf en dataf par fleet
splitStrg <- function (dataf,nomdudataf)
{
listStrg <- unique(dataf$strategy)
#nomdudataf <- paste("dataf.",nom)
splitInStrg.f <- function (i,ledataf,nomdudataf, listStrg)
   {
   ledataf.strg <- ledataf[ledataf$strategy == listStrg[i],]
   assign(paste(nomdudataf,".", as.character(listStrg[i]),sep=""),ledataf.strg, env = .GlobalEnv)
   }
lapply(1:length(listStrg), splitInStrg.f, dataf, nomdudataf, listStrg)
}

#----------------------------------------
#----------------------------------------
#----------------------------------------
plottingIsisExports <-function(aStock,typedata,perAge,perZone,perFleet,aFleet,...)
{ 
palette(rainbow(16)) # 16 colors...
if(!exists("leg.location")) leg.location <- 1/4 # placer la legende 1/4 au dessus de la valeur max

if(!exists("year.dep")) 
   {
   warning("you should set the 'year.dep' variable as a global variable...")
   year.dep <- 1 # i.e. 2001
   } 

if((!exists("exportPathFromIsis") && !exists("repository.name")) || (is.null("exportPathFromIsis") || is.null("repository.name")))
  {
  warning("you should set a path for the 'repository.name' variable as a global variable...")                           
  path <- "Q:\\sourcesR\\ModelBrest\\withFLFleet&Metiers\\Isis-FLR-1Sep06\\output\\compareWithIsisFish\\hake.ttesStrategiesWithSpain&hakeBox-jum&VHVO..-05_09_2006-1222\\" 
  } else { 
  path <-paste(exportPathFromIsis,repository.name,sep="")}

print(path)
dataf <- read.csv(paste(path,typedata,".csv",sep="") ,sep=";")
if(typedata=="CapturesPoids" || typedata=="CapturesNombre")  names(dataf) <- c("population","strategy","metier","age","zonepop","date",typedata)
if(typedata=="Biomasses" || typedata=="Abondances") names(dataf) <- c("population","age","zonepop","date",typedata)
if(typedata=="EffortsMetier") names(dataf) <- c("strategy","metier","date",typedata)

if(any("strategy"==names(dataf)))
 { 
 if(aFleet!="all")
  {
  # 1. split en fleet (~strg)
  listStrg <- unique(dataf$strategy)
  splitStrg (dataf, paste("dataf.",typedata,sep=""))
  dataf1 <<- get(paste("dataf.",typedata,".",aFleet,sep=""))
  } else  dataf1 <<- dataf
 } else  {perFleet<-FALSE ;dataf1 <<- dataf}

if(any("population"==names(dataf1)))
 { 
 # 1. split en population
 listPop <<- unique(dataf1$population)
 if(length(listPop)>1)
  {
  splitPop (dataf1, paste("dataf1.",typedata,sep=""))
  dataf2 <<- get(paste("dataf1.",typedata,".",aStock,sep=""))
  } else dataf2 <<- dataf1
 } else dataf2 <<- dataf1

##########################
#plotting per date
if(perZone==FALSE && perFleet==FALSE)
  {
  if(perAge==TRUE)
    {
    windows()
    leg<-list()
    ww <- aggregate(eval(parse("",text=paste("dataf2$",typedata,sep=""))),by=list(date = dataf2$date,age=dataf2$age),sum)
    names(ww)
    #library(lattice) ; bwplot(x~date,ww,groups=zone)
    # faire plutôt:
    www<- split(ww,ww$age)
    for (i in 1: length(www))
      {
      X <- matrix(as.numeric(as.matrix(www[[i]][,c("date","x")])),ncol=2)
      if(i==1) plot(0,0,ylab=typedata,xlab="date",xlim=c(0,max(as.numeric(ww$date))),
                  ylim=c(0,max(as.numeric(ww$x))+leg.location*(max(as.numeric(ww$x)))),type="n",axes=FALSE)
      lines(X[,1],X[,2],lty=i,col=i)
       leg[["name"]] <- c(leg[["name"]],as.character(www[[i]]$age[1]))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       }
    title(main=paste(typedata,"per age for",aStock)) 
    axis(2)
    axis(1, at = seq(0,(max(X[,1])+1),by=12),
               labels =  paste("200",year.dep:(year.dep+((max(X[,1])+1)/12)),sep="") )
    legend (1,(max(as.numeric(ww$x)))+leg.location*(max(as.numeric(ww$x))),leg[["name"]], col = leg[["col"]],lty = leg[["lty"]], cex = 0.7)
    } 
    else
    {
    palette("default")
    windows()
    ww <- aggregate(eval(parse("",text=paste("dataf2$",typedata,sep=""))),by=list(date = dataf2$date),sum)
    names(ww)
    X <- matrix(as.numeric(as.matrix(ww)),ncol=2)
    plot(0,0,xlim=c(0,max(X[,1])),ylim=c(0,max(X[,2])),xlab="date",ylab=typedata,type="n",axes=FALSE)
    title(main=paste(typedata,"for",aStock)) 
    lines(X[,1],X[,2],col=1)
    axis(2)
    axis(1, at = seq(0,(max(X[,1])+1),by=12),
               labels =  paste("200",year.dep:(year.dep+((max(X[,1])+1)/12)),sep="") )
    # legend()
    } # end else
  }

##########################
#plotting per date per zone
if(perZone==TRUE && perFleet==FALSE)
  {
  windows()
  leg<-list()
  ww <- aggregate(eval(parse("",text=paste("dataf2$",typedata,sep=""))),by=list(date = dataf2$date,zone=dataf2$zone),sum)
  names(ww)
  #library(lattice) ; bwplot(x~date,ww,groups=zone)
  # faire plutôt:
  www<- split(ww,ww$zone)
  for (i in 1: length(www))
    {
    X <- matrix(as.numeric(as.matrix(www[[i]][,c("date","x")])),ncol=2)
    if(i==1) plot(0,0,ylab=typedata,xlab="date",xlim=c(0,max(as.numeric(ww$date))),
                  ylim=c(0,max(as.numeric(ww$x))+leg.location*(max(as.numeric(ww$x)))),type="n",axes=FALSE)
    lines(X[,1],X[,2],lty=i,col=i)
       leg[["name"]] <- c(leg[["name"]],as.character(www[[i]]$zone[1]))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
    }
  title(main=paste(typedata,"per zone for",aStock)) 
  axis(2)
  axis(1, at = seq(0,(max(X[,1])+1),by=12),
               labels =  paste("200",year.dep:(year.dep+((max(X[,1])+1)/12)),sep="") )
  legend (1,(max(as.numeric(ww$x)))+leg.location*(max(as.numeric(ww$x))),leg[["name"]], col = leg[["col"]],lty = leg[["lty"]], cex = 0.7)
  }

##########################
#if metier, plotting per date per metier
if(perZone==FALSE && perFleet==TRUE)
     {
     if(any("metier"==names(dataf2)))
     {
     windows()
     leg<-list()
     ww <- aggregate(eval(parse("",text=paste("dataf2$",typedata,sep=""))),by=list(date = dataf2$date,strategy=dataf2$strategy,metier=dataf2$metier),sum)
     names(ww)
     www<- split(ww,list(ww$strategy,ww$metier))
     for (i in 1: length(www))
       {
       X <- matrix(as.numeric(as.matrix(www[[i]][,c("date","x")])),ncol=2)
       if(i==1) plot(0,0,ylab=typedata,xlab="date",xlim=c(0,max(as.numeric(ww$date))),
                    ylim=c(0,max(as.numeric(ww$x))+leg.location*(max(as.numeric(ww$x)))),type="n",axes=FALSE)
       lines(X[,1],X[,2],lty=i,col=i)  ;points(X[,1],X[,2],col=i,pch=i,cex=0.5)
       leg[["name"]] <- c(leg[["name"]],paste(www[[i]]$strategy[1],"-",www[[i]]$metier[1],sep=""))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       leg[["pch"]]  <- c(leg[["pch"]] ,i)
      }
     title(main=paste(typedata,"per strategy per metier for",aFleet)) 
     axis(2)
     axis(1, at = seq(0,(max(X[,1])+1),by=12),
               labels =  paste("200",year.dep:(year.dep+((max(X[,1])+1)/12)),sep="") )
    legend (1,(max(as.numeric(ww$x)))+leg.location*(max(as.numeric(ww$x))),leg[["name"]], col = leg[["col"]],lty = leg[["lty"]],pch = leg[["pch"]], cex = 0.7)
    } else{warning(paste("no 'metier' field is defined in the",typedata," data file"))} 
   }  

##########################
#if metier, plotting per date per metier per zone
if(perZone==TRUE && perFleet==TRUE)
   {
    if(any("metier"==names(dataf1)))
     {
     windows()
     leg<-list()
     ww <- aggregate(eval(parse("",text=paste("dataf2$",typedata,sep=""))),by=list(date = dataf2$date,strategy=dataf2$strategy,metier=dataf2$metier,zone=dataf2$zone),sum)
     names(ww)
     www<- split(ww,list(ww$strategy,ww$metier,ww$zone))
     for (i in 1: length(www))
      {
      X <- matrix(as.numeric(as.matrix(www[[i]][,c("date","x")])),ncol=2)
      if(i==1) plot(0,0,xlim=c(0,max(as.numeric(ww$date))),ylim=c(0,max(as.numeric(ww$x))),type="n",axes=FALSE)
      lines(X[,1],X[,2],lty=i,col=i)  ;points(X[,1],X[,2],col=i,pch=i,cex=0.5)
       leg[["name"]] <- c(leg[["name"]],paste(www[[i]]$strategy[1],"-",www[[i]]$metier[1],"-",www[[i]]$zone[1],sep=""))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       leg[["pch"]]  <- c(leg[["pch"]] ,i)

      }
     title(main=paste(typedata,"per strategy per metier per zone for",aFleet)) 
     axis(2)
     axis(1, at = seq(0,(max(X[,1])+1),by=12),
               labels =  paste("200",year.dep:(year.dep+((max(X[,1])+1)/12)),sep="") )

  legend (1,(max(as.numeric(ww$x)))+leg.location*(max(as.numeric(ww$x))),leg[["name"]], col = leg[["col"]],lty = leg[["lty"]],pch = leg[["pch"]], cex = 0.7)
     } else{warning(paste("no 'metier' field is defined in the",typedata," data file"))} 
   } 

return()
}

[Isis-fish-devel] interface R pour plotter les resultats d'isis-fish

Francois.Bastardie＠ifremer.fr