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()
#---------------------------------------------------------
#---------------------------------------------------------
# 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 mailing list
Isis-fish-devel@lists.labs.libre-entreprise.org
http://lists.labs.libre-entreprise.org/mailman/listinfo/isis-fish-devel