#********************************************************************
# Function to extract CTS data to calculate CPH sizes at start of simulation
#cphsizes_estimate <- function(uid = NULL,
extract_cts_init <- function(uid = NULL,
pwd = NULL,
modeldata
#startdate = '2012/01/01',
){
#require(RPostgreSQL)
# Obtain EPIC username and password, if not yet specified
#if(is.null(uid) | is.null(pwd)){
# uid <- readline(prompt = "EPIC user ID: ")
# }
# if(is.null(pwd)){
# pwd <- readline(prompt = "EPIC password: ")
# credentials <- getLoginDetails()
# uid <- credentials[names(credentials) == 'uid']
# pwd <- credentials[names(credentials) == 'pwd']
#}
if(is.null(uid) | is.null(pwd)){
if(Sys.info()['sysname'] != 'Linux'){
stop('EPIC.SimInf cannot currently extract data from the EPIC server under OSX or Windows systems. Please extract data using your preferred SQL software, and import to R.')
}
else{
cat('Please supply your login details to extract data from the EPIC server.\n')
}
if(is.null(uid)){
uid <- getPass('Username:')
}
if(is.null(pwd)){
pwd <- getPass('Password:')
}
}
# Check if RPostgreSQL is available
if (!requireNamespace('RPostgreSQL', quietly = TRUE)) {
stop("RPostgreSQL is needed for this function to work. Please install it using install.packages('RPostgreSQL').",
call. = FALSE)
}
cat('Extracting CPH size data from EPIC server (this may take a while)... ')
# Set up PostgreSQL connection to EPIC server
drv <- dbDriver("PostgreSQL")
epicserver <- dbConnect(drv, host="epic.mvls.gla.ac.uk",
port="5432",
dbname="epic",
user = uid,
password = pwd)
# SQL query to extract CPH sizes data
rs <- dbSendQuery(epicserver, paste("
SELECT
cattle_per_cph.location_id AS location_id,
cattle_per_cph.cph AS cphh,
COUNT(cattle_per_cph.animal_id) AS num_cattle
FROM
(-- Table of cattle IDs per CPH on the specified date
SELECT DISTINCT
cph_numbers.location_id AS location_id,
cph,
animal_id
FROM
--****************************************************************
(-- Table of cattle IDs, and on/off moves per location ID
SELECT DISTINCT
move_on.on_location_id AS location_id,
move_on.animal_id,
move_on.movement_date AS on_date,
move_off.movement_date AS off_date
FROM
--****************************************************************
(-- Table of animals moved ONTO the location BEFORE the date of interest
SELECT DISTINCT
on_location_id,
animal_id,
movement_date
FROM cts201404.movements
WHERE (movement_date < '", modeldata$startdate, "')
AND is_valid_history = 't'
AND is_trans = 'f'
) AS move_on
--****************************************************************
LEFT JOIN
--****************************************************************
(-- Table of animals moved OFF OF the location AFTER the date of interest
SELECT DISTINCT
off_location_id,
animal_id,
movement_date
FROM cts201404.movements
WHERE is_valid_history = 't'
AND is_trans = 'f'
) AS move_off
--****************************************************************
ON (move_on.animal_id = move_off.animal_id)
AND (move_on.on_location_id = move_off.off_location_id)
-- Select only the cattle for which the off movement is after the date of interest, or non-existent (i.e. the animal is presumably still on the farm)
WHERE (move_off.movement_date >= '", modeldata$startdate, "')
OR (move_off.movement_date IS NULL)
) AS cattle_numbers
--****************************************************************
LEFT JOIN
--****************************************************************
(-- Table of CPH numbers and associated location IDs
SELECT DISTINCT
location_id,
cph
FROM cts201404.locations
) AS cph_numbers
--****************************************************************
ON (cattle_numbers.location_id = cph_numbers.location_id)
) AS cattle_per_cph
GROUP BY
cattle_per_cph.location_id,
cattle_per_cph.cph", sep = ''))
# Run SQL query on EPIC server
modeldata$init <- dbFetch(rs, n = Inf)
cat('done\n')
# Close connection to EPIC server
dbDisconnect(epicserver)
return(modeldata)
}
#********************************************************************
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.