interface R pour plotter les resultats d'isis-fish

1 Sep 2006

      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                                
#---------------------------------------------------------
#---------------------------------------------------------

# source this current script in a R session 
# and launch interfaceExportFromIsis() function.

#------------------------------------
#------------------------------------
interfaceExportFromIsis <- function()
{

require(tcltk)
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 <- tktext(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(tklabel(ttPlotIsis,text=" "))
   tkgrid(tklabel(ttPlotIsis,text=" "))

listForPlotting <<-list()
a.vect <- c("namesim")          

   tkgrid(tklabel(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-30Aug06-demo\\output\\compareWithIsisFish\\",
                      "hake.ttesStrategiesWithSpain&hakeBox-jum&VHVO..-31_08_2006-1414\\") 
default.values8 <- c("1","1/4") 
for (hh in 1:length(aText7))
  {  
  listOptionsPath[[hh]] <<- tkentry(ttPlotIsis,width=70,textvariable=tclVar(default.values7[hh]))
  tkgrid(tklabel(ttPlotIsis,text=aText7[hh]),listOptionsPath[[hh]])
  }
for (hh in 1:length(aText8))
  {  
  listOptionsNumeric[[hh]] <<- tkentry(ttPlotIsis,width=70,textvariable=tclVar(default.values8[hh]))
  tkgrid(tklabel(ttPlotIsis,text=aText8[hh]),listOptionsNumeric[[hh]])
  }

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

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

typeOfArgs <- c("aStock=\"merluccius\" typedata=\"CapturesPoids\" perZone=FALSE perMetier=FALSE",
                "aStock=\"merluccius\" typedata=\"Biomasses\" perZone=FALSE perMetier=FALSE",
                "aFleet=\"all\" typedata=\"EffortsMetier\" perFleet=FALSE perMetier=FALSE"
                )
typeOfFunc <- c("plottingStockIsis",
                "plottingStockIsis",
                "plottingFleetIsis"
               )

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=50,textvariable=tclVar(as.character(typeOfArgs[tof])))
  listForPlotIsis[[it+2]] <<- tkcheckbutton(ttPlotIsis)
  cbValForPlotIsis[[it]] <<-0;cbValForPlotIsis[[it+1]]<<-0;cbValForPlotIsis[[it+2]]<<- tclVar("0")

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

  it<-it+3
  }

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

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

tkfocus(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$strg)
#nomdudataf <- paste("dataf.",nom)
splitInStrg.f <- function (i,ledataf,nomdudataf, listStrg)
   {
   ledataf.strg <- ledataf[ledataf$strg == listStrg[i],]
   assign(paste(nomdudataf,".", as.character(listStrg[i]),sep=""),ledataf.strg, env = .GlobalEnv)
   }
lapply(1:length(listStrg), splitInStrg.f, dataf, nomdudataf, listStrg)
}

#----------------------------------------
#----------------------------------------
#----------------------------------------
plottingFleetIsis <-function(aFleet,typedata,perFleet,perMetier,...)
{ 
palette(rainbow(16)) # 16 colors...
if(!exists("leg.location")) 
   {
   warning("you should set the 'leg.location' variable as global variable...")
   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 global variable...")
   year.dep <- 1 # i.e. 2001
   } 

if(!exists("exportPathFromIsis") && !exists("repository.name") )
  {
  warning("you should set a path for data repository as global variable...")                           
  path <- "Q:\\sourcesR\\ModelBrest\\withFLFleet&Metiers\\Isis-FLR-v22Aout06\\output\\compareWithIsisFish\\hake.ttesStrategiesWithSpain-25_08_2006-1216\\" 
  } else {
         path <-paste(exportPathFromIsis,repository.name,sep="")}

  dataf <- read.csv(paste(path,typedata,".csv",sep="") ,sep=";")
if(typedata=="EffortsMetier") names(dataf) <- c("strg","metier","date",typedata)

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

if(perFleet==FALSE && perMetier==FALSE)
  {
  palette("default")
  windows()
  ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$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",aFleet)) 
  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()
  }

##########################
#plotting per date per fleet
if(perFleet==TRUE && perMetier==FALSE)
  {
  windows()
  leg<-list()
  ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$date,strg=dataf1$strg),sum)
  names(ww)
  #library(lattice) ; bwplot(x~date,ww,groups=zone)
  # faire plutôt:
  www<- split(ww,ww$strg)
  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"]],as.character(www[[i]]$strg[1]))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       leg[["pch"]]  <- c(leg[["pch"]] ,i)
    }
  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="") )
  title(main=paste(typedata,"per fleet for",aFleet)) 
  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)
  }

##########################
#plotting per date per metier
if(perFleet==FALSE && perMetier==TRUE)
  {
  windows()
  leg<-list()
  ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$date,metier=dataf1$metier),sum)
  names(ww)
  #library(lattice) ; bwplot(x~date,ww,groups=zone)
  # faire plutôt:
  www<- split(ww,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"]],as.character(www[[i]]$metier[1]))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       leg[["pch"]]  <- c(leg[["pch"]] ,i)
    }
  title(main=paste(typedata,"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)
  }

return()
}

#----------------------------------------
#----------------------------------------
#----------------------------------------
plottingStockIsis <-function(aStock,typedata,perZone,perMetier,...)
{ 
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") )
  {
  warning("you should set a path for the 'repository.name' variable as a global variable...")                           
  path <- "Q:\\sourcesR\\ModelBrest\\withFLFleet&Metiers\\Isis-FLR-30Aug06-demo\\output\\compareWithIsisFish\\hake.ttesStrategiesWithSpain&hakeBox-jum&VHVO..-31_08_2006-1414\\" 
  } else {
  path <-paste(exportPathFromIsis,repository.name,sep="")}

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

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

##########################
#plotting per date
if(perZone==FALSE && perMetier==FALSE)
  {
  palette("default")
  windows()
  ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$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()
  }

##########################
#plotting per date per zone
if(perZone==TRUE && perMetier==FALSE)
  {
  windows()
  leg<-list()
  ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$date,zone=dataf1$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 && perMetier==TRUE)
     {
     if(any("metier"==names(dataf1)))
     {
     windows()
     leg<-list()
     ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$date,metier=dataf1$metier),sum)
     names(ww)
     www<- split(ww,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],col=i)
       leg[["name"]] <- c(leg[["name"]],as.character(www[[i]]$metier[1]))
       leg[["col"]]  <- c(leg[["col"]],i)
       leg[["lty"]]  <- c(leg[["lty"]] ,i)
       }
     title(main=paste(typedata,"per metier 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{warning(paste("no 'metier' field is defined in the",typedata," data file"))} 
   }  

##########################
#if metier, plotting per date per metier per zone
if(perZone==TRUE && perMetier==TRUE)
   {
    if(any("metier"==names(dataf1)))
     {
     windows()
     ww <- aggregate(eval(parse("",text=paste("dataf1$",typedata,sep=""))),by=list(date = dataf1$date,metier=dataf1$metier,zone=dataf1$zone),sum)
     names(ww)
     www<- split(ww,list(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],col=i)
      }
     title(main=paste(typedata,"per metier 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()
     } else{warning(paste("no 'metier' field is defined in the",typedata," data file"))} 
   } 

return()
}

Francois.Bastardie＠ifremer.fr

tags

participants (1)