diff --git a/.Rbuildignore b/.Rbuildignore
index 4b3f9f2c270555351c5f4e1add8695d20d52e894..5ba5f81074d8f4359b1403d4b150b2c8bf5fbc33 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -1,3 +1,6 @@
^.*\.Rproj$
^\.Rproj\.user$
^data-raw$
+^LICENSE\.md$
+^doc$
+^Meta$
diff --git a/.gitignore b/.gitignore
index 89d48e72d06a70407edea87d3cbe7629ca2dc958..f8c8cb59bc04fecf7a081b0badb17b5b2c42bdff 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,6 @@ inst/doc
.RDataTmp2
.RDataTmp3
test
+output_ERA5_test.rda
+/doc/
+/Meta/
diff --git a/DESCRIPTION b/DESCRIPTION
index 216a1544620352a92d83143de5588aed1a8400cd..55c59a17a8965fd7460babd5df5d260d753073fe 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,45 +1,38 @@
-Package: ArboRisk
+Package: arbocartoR
Type: Package
-Title: What the Package Does (Title Case)
-Version: 0.1.0
-Author: Who wrote it
-Maintainer: The package maintainer <yourself@somewhere.net>
-Description: More about what it does (maybe more than one line)
- Use four spaces when indenting paragraphs within the Description.
-License: What license is it under?
+Title: Simulation tool to support Aedes-borne diseases emergence prepardness
+Version: 0.1.5
+Author: Hammami Pachka, Marti Renaud, Tran Annelise, Apolloni Andrea, Ortega Ewy, Arsevska Elena (Cirad - UMR ASTRE, funded by Mood project)
+Maintainer: The package maintainer <pachka.hammami@cirad.fr>
+Description: Run dynamic prediction of Aedes vectors population (in time and space) and simulate epidemiological trajectories following introductions in disease free areas.
+License: CECILL C free licence + file LICENSE
Language: en-US
LazyData: true
Encoding: UTF-8
-Depends: R (>= 4.0.0)
-Imports:
- SimInf (>= 9.5.0),
- data.table (>= 1.14.8),
- magrittr (>= 2.0.3),
- chron (>= 2.3-60),
- terra (>= 1.7-18),
- tidyterra (>= 0.4.0),
- ggplot2 (>= 3.4.1),
- raster (>= 3.6-20),
- sp (>= 1.6-0),
- sf (>= 1.0-12),
- geodata (>= 0.5-3),
- zoo (>= 1.8-11),
- stringdist (>= 0.9.10),
- stringr (>= 1.5.0),
- leaflet (>= 2.1.2),
- RColorBrewer (>= 1.1-3),
- imputeTS (>= 3.3),
- parallel,
- doParallel (>= 1.0.17),
- foreach (>= 1.5.2),
- pbapply (>= 1.7-0),
- igraph,
- fields
+Depends:
+ R (>= 4.0.0),
+ data.table (>= 1.14.10),
+ SimInf (>= 9.6.0),
+ magrittr (>= 2.0.3)
+Imports:
+ pbapply (>= 1.7-2),
+ terra (>= 1.7-65),
+ sf (>= 1.0-15),
+ dygraphs (>= 1.1.1.6),
+ stats,
+ TDLM (>= 1.0.0),
+ shiny (>= 1.8.0)
+Remotes:
+ EpiVec/TDLM
Suggests:
knitr (>= 1.42),
rmarkdown (>= 2.20),
- testthat (>= 3.0.0)
+ testthat (>= 3.0.0),
+ tidyterra,
+ ggplot2,
+ fastmatrix,
+ matlib
VignetteBuilder:
knitr
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
Config/testthat/edition: 3
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..00a6b66bf32d0196a140b504523993472bb775ea
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,516 @@
+CeCILL-C FREE SOFTWARE LICENSE AGREEMENT
+
+
+ Notice
+
+This Agreement is a Free Software license agreement that is the result
+of discussions between its authors in order to ensure compliance with
+the two main principles guiding its drafting:
+
+ * firstly, compliance with the principles governing the distribution
+ of Free Software: access to source code, broad rights granted to
+ users,
+ * secondly, the election of a governing law, French law, with which
+ it is conformant, both as regards the law of torts and
+ intellectual property law, and the protection that it offers to
+ both authors and holders of the economic rights over software.
+
+The authors of the CeCILL-C (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+license are:
+
+Commissariat à l'Energie Atomique - CEA, a public scientific, technical
+and industrial research establishment, having its principal place of
+business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+
+Centre National de la Recherche Scientifique - CNRS, a public scientific
+and technological establishment, having its principal place of business
+at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+
+Institut National de Recherche en Informatique et en Automatique -
+INRIA, a public scientific and technological establishment, having its
+principal place of business at Domaine de Voluceau, Rocquencourt, BP
+105, 78153 Le Chesnay cedex, France.
+
+
+ Preamble
+
+The purpose of this Free Software license agreement is to grant users
+the right to modify and re-use the software governed by this license.
+
+The exercising of this right is conditional upon the obligation to make
+available to the community the modifications made to the source code of
+the software so as to contribute to its evolution.
+
+In consideration of access to the source code and the rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty and the software's author, the holder of the
+economic rights, and the successive licensors only have limited liability.
+
+In this respect, the risks associated with loading, using, modifying
+and/or developing or reproducing the software by the user are brought to
+the user's attention, given its Free Software status, which may make it
+complicated to use, with the result that its use is reserved for
+developers and experienced professionals having in-depth computer
+knowledge. Users are therefore encouraged to load and test the
+suitability of the software as regards their requirements in conditions
+enabling the security of their systems and/or data to be ensured and,
+more generally, to use and operate it in the same conditions of
+security. This Agreement may be freely reproduced and published,
+provided it is not altered, and that no provisions are either added or
+removed herefrom.
+
+This Agreement may apply to any or all software for which the holder of
+the economic rights decides to submit the use thereof to its provisions.
+
+
+ Article 1 - DEFINITIONS
+
+For the purpose of this Agreement, when the following expressions
+commence with a capital letter, they shall have the following meaning:
+
+Agreement: means this license agreement, and its possible subsequent
+versions and annexes.
+
+Software: means the software in its Object Code and/or Source Code form
+and, where applicable, its documentation, "as is" when the Licensee
+accepts the Agreement.
+
+Initial Software: means the Software in its Source Code and possibly its
+Object Code form and, where applicable, its documentation, "as is" when
+it is first distributed under the terms and conditions of the Agreement.
+
+Modified Software: means the Software modified by at least one
+Integrated Contribution.
+
+Source Code: means all the Software's instructions and program lines to
+which access is required so as to modify the Software.
+
+Object Code: means the binary files originating from the compilation of
+the Source Code.
+
+Holder: means the holder(s) of the economic rights over the Initial
+Software.
+
+Licensee: means the Software user(s) having accepted the Agreement.
+
+Contributor: means a Licensee having made at least one Integrated
+Contribution.
+
+Licensor: means the Holder, or any other individual or legal entity, who
+distributes the Software under the Agreement.
+
+Integrated Contribution: means any or all modifications, corrections,
+translations, adaptations and/or new functions integrated into the
+Source Code by any or all Contributors.
+
+Related Module: means a set of sources files including their
+documentation that, without modification to the Source Code, enables
+supplementary functions or services in addition to those offered by the
+Software.
+
+Derivative Software: means any combination of the Software, modified or
+not, and of a Related Module.
+
+Parties: mean both the Licensee and the Licensor.
+
+These expressions may be used both in singular and plural form.
+
+
+ Article 2 - PURPOSE
+
+The purpose of the Agreement is the grant by the Licensor to the
+Licensee of a non-exclusive, transferable and worldwide license for the
+Software as set forth in Article 5 hereinafter for the whole term of the
+protection granted by the rights over said Software.
+
+
+ Article 3 - ACCEPTANCE
+
+3.1 The Licensee shall be deemed as having accepted the terms and
+conditions of this Agreement upon the occurrence of the first of the
+following events:
+
+ * (i) loading the Software by any or all means, notably, by
+ downloading from a remote server, or by loading from a physical
+ medium;
+ * (ii) the first time the Licensee exercises any of the rights
+ granted hereunder.
+
+3.2 One copy of the Agreement, containing a notice relating to the
+characteristics of the Software, to the limited warranty, and to the
+fact that its use is restricted to experienced users has been provided
+to the Licensee prior to its acceptance as set forth in Article 3.1
+hereinabove, and the Licensee hereby acknowledges that it has read and
+understood it.
+
+
+ Article 4 - EFFECTIVE DATE AND TERM
+
+
+ 4.1 EFFECTIVE DATE
+
+The Agreement shall become effective on the date when it is accepted by
+the Licensee as set forth in Article 3.1.
+
+
+ 4.2 TERM
+
+The Agreement shall remain in force for the entire legal term of
+protection of the economic rights over the Software.
+
+
+ Article 5 - SCOPE OF RIGHTS GRANTED
+
+The Licensor hereby grants to the Licensee, who accepts, the following
+rights over the Software for any or all use, and for the term of the
+Agreement, on the basis of the terms and conditions set forth hereinafter.
+
+Besides, if the Licensor owns or comes to own one or more patents
+protecting all or part of the functions of the Software or of its
+components, the Licensor undertakes not to enforce the rights granted by
+these patents against successive Licensees using, exploiting or
+modifying the Software. If these patents are transferred, the Licensor
+undertakes to have the transferees subscribe to the obligations set
+forth in this paragraph.
+
+
+ 5.1 RIGHT OF USE
+
+The Licensee is authorized to use the Software, without any limitation
+as to its fields of application, with it being hereinafter specified
+that this comprises:
+
+ 1. permanent or temporary reproduction of all or part of the Software
+ by any or all means and in any or all form.
+
+ 2. loading, displaying, running, or storing the Software on any or
+ all medium.
+
+ 3. entitlement to observe, study or test its operation so as to
+ determine the ideas and principles behind any or all constituent
+ elements of said Software. This shall apply when the Licensee
+ carries out any or all loading, displaying, running, transmission
+ or storage operation as regards the Software, that it is entitled
+ to carry out hereunder.
+
+
+ 5.2 RIGHT OF MODIFICATION
+
+The right of modification includes the right to translate, adapt,
+arrange, or make any or all modifications to the Software, and the right
+to reproduce the resulting software. It includes, in particular, the
+right to create a Derivative Software.
+
+The Licensee is authorized to make any or all modification to the
+Software provided that it includes an explicit notice that it is the
+author of said modification and indicates the date of the creation thereof.
+
+
+ 5.3 RIGHT OF DISTRIBUTION
+
+In particular, the right of distribution includes the right to publish,
+transmit and communicate the Software to the general public on any or
+all medium, and by any or all means, and the right to market, either in
+consideration of a fee, or free of charge, one or more copies of the
+Software by any means.
+
+The Licensee is further authorized to distribute copies of the modified
+or unmodified Software to third parties according to the terms and
+conditions set forth hereinafter.
+
+
+ 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+
+The Licensee is authorized to distribute true copies of the Software in
+Source Code or Object Code form, provided that said distribution
+complies with all the provisions of the Agreement and is accompanied by:
+
+ 1. a copy of the Agreement,
+
+ 2. a notice relating to the limitation of both the Licensor's
+ warranty and liability as set forth in Articles 8 and 9,
+
+and that, in the event that only the Object Code of the Software is
+redistributed, the Licensee allows effective access to the full Source
+Code of the Software at a minimum during the entire period of its
+distribution of the Software, it being understood that the additional
+cost of acquiring the Source Code shall not exceed the cost of
+transferring the data.
+
+
+ 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+
+When the Licensee makes an Integrated Contribution to the Software, the
+terms and conditions for the distribution of the resulting Modified
+Software become subject to all the provisions of this Agreement.
+
+The Licensee is authorized to distribute the Modified Software, in
+source code or object code form, provided that said distribution
+complies with all the provisions of the Agreement and is accompanied by:
+
+ 1. a copy of the Agreement,
+
+ 2. a notice relating to the limitation of both the Licensor's
+ warranty and liability as set forth in Articles 8 and 9,
+
+and that, in the event that only the object code of the Modified
+Software is redistributed, the Licensee allows effective access to the
+full source code of the Modified Software at a minimum during the entire
+period of its distribution of the Modified Software, it being understood
+that the additional cost of acquiring the source code shall not exceed
+the cost of transferring the data.
+
+
+ 5.3.3 DISTRIBUTION OF DERIVATIVE SOFTWARE
+
+When the Licensee creates Derivative Software, this Derivative Software
+may be distributed under a license agreement other than this Agreement,
+subject to compliance with the requirement to include a notice
+concerning the rights over the Software as defined in Article 6.4.
+In the event the creation of the Derivative Software required modification
+of the Source Code, the Licensee undertakes that:
+
+ 1. the resulting Modified Software will be governed by this Agreement,
+ 2. the Integrated Contributions in the resulting Modified Software
+ will be clearly identified and documented,
+ 3. the Licensee will allow effective access to the source code of the
+ Modified Software, at a minimum during the entire period of
+ distribution of the Derivative Software, such that such
+ modifications may be carried over in a subsequent version of the
+ Software; it being understood that the additional cost of
+ purchasing the source code of the Modified Software shall not
+ exceed the cost of transferring the data.
+
+
+ 5.3.4 COMPATIBILITY WITH THE CeCILL LICENSE
+
+When a Modified Software contains an Integrated Contribution subject to
+the CeCILL license agreement, or when a Derivative Software contains a
+Related Module subject to the CeCILL license agreement, the provisions
+set forth in the third item of Article 6.4 are optional.
+
+
+ Article 6 - INTELLECTUAL PROPERTY
+
+
+ 6.1 OVER THE INITIAL SOFTWARE
+
+The Holder owns the economic rights over the Initial Software. Any or
+all use of the Initial Software is subject to compliance with the terms
+and conditions under which the Holder has elected to distribute its work
+and no one shall be entitled to modify the terms and conditions for the
+distribution of said Initial Software.
+
+The Holder undertakes that the Initial Software will remain ruled at
+least by this Agreement, for the duration set forth in Article 4.2.
+
+
+ 6.2 OVER THE INTEGRATED CONTRIBUTIONS
+
+The Licensee who develops an Integrated Contribution is the owner of the
+intellectual property rights over this Contribution as defined by
+applicable law.
+
+
+ 6.3 OVER THE RELATED MODULES
+
+The Licensee who develops a Related Module is the owner of the
+intellectual property rights over this Related Module as defined by
+applicable law and is free to choose the type of agreement that shall
+govern its distribution under the conditions defined in Article 5.3.3.
+
+
+ 6.4 NOTICE OF RIGHTS
+
+The Licensee expressly undertakes:
+
+ 1. not to remove, or modify, in any manner, the intellectual property
+ notices attached to the Software;
+
+ 2. to reproduce said notices, in an identical manner, in the copies
+ of the Software modified or not;
+
+ 3. to ensure that use of the Software, its intellectual property
+ notices and the fact that it is governed by the Agreement is
+ indicated in a text that is easily accessible, specifically from
+ the interface of any Derivative Software.
+
+The Licensee undertakes not to directly or indirectly infringe the
+intellectual property rights of the Holder and/or Contributors on the
+Software and to take, where applicable, vis-Ã -vis its staff, any and all
+measures required to ensure respect of said intellectual property rights
+of the Holder and/or Contributors.
+
+
+ Article 7 - RELATED SERVICES
+
+7.1 Under no circumstances shall the Agreement oblige the Licensor to
+provide technical assistance or maintenance services for the Software.
+
+However, the Licensor is entitled to offer this type of services. The
+terms and conditions of such technical assistance, and/or such
+maintenance, shall be set forth in a separate instrument. Only the
+Licensor offering said maintenance and/or technical assistance services
+shall incur liability therefor.
+
+7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+its sole responsibility, a warranty, that shall only be binding upon
+itself, for the redistribution of the Software and/or the Modified
+Software, under terms and conditions that it is free to decide. Said
+warranty, and the financial terms and conditions of its application,
+shall be subject of a separate instrument executed between the Licensor
+and the Licensee.
+
+
+ Article 8 - LIABILITY
+
+8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+entitled to claim compensation for any direct loss it may have suffered
+from the Software as a result of a fault on the part of the relevant
+Licensor, subject to providing evidence thereof.
+
+8.2 The Licensor's liability is limited to the commitments made under
+this Agreement and shall not be incurred as a result of in particular:
+(i) loss due the Licensee's total or partial failure to fulfill its
+obligations, (ii) direct or consequential loss that is suffered by the
+Licensee due to the use or performance of the Software, and (iii) more
+generally, any consequential loss. In particular the Parties expressly
+agree that any or all pecuniary or business loss (i.e. loss of data,
+loss of profits, operating loss, loss of customers or orders,
+opportunity cost, any disturbance to business activities) or any or all
+legal proceedings instituted against the Licensee by a third party,
+shall constitute consequential loss and shall not provide entitlement to
+any or all compensation from the Licensor.
+
+
+ Article 9 - WARRANTY
+
+9.1 The Licensee acknowledges that the scientific and technical
+state-of-the-art when the Software was distributed did not enable all
+possible uses to be tested and verified, nor for the presence of
+possible defects to be detected. In this respect, the Licensee's
+attention has been drawn to the risks associated with loading, using,
+modifying and/or developing and reproducing the Software which are
+reserved for experienced users.
+
+The Licensee shall be responsible for verifying, by any or all means,
+the suitability of the product for its requirements, its good working
+order, and for ensuring that it shall not cause damage to either persons
+or properties.
+
+9.2 The Licensor hereby represents, in good faith, that it is entitled
+to grant all the rights over the Software (including in particular the
+rights set forth in Article 5).
+
+9.3 The Licensee acknowledges that the Software is supplied "as is" by
+the Licensor without any other express or tacit warranty, other than
+that provided for in Article 9.2 and, in particular, without any warranty
+as to its commercial value, its secured, safe, innovative or relevant
+nature.
+
+Specifically, the Licensor does not warrant that the Software is free
+from any error, that it will operate without interruption, that it will
+be compatible with the Licensee's own equipment and software
+configuration, nor that it will meet the Licensee's requirements.
+
+9.4 The Licensor does not either expressly or tacitly warrant that the
+Software does not infringe any third party intellectual property right
+relating to a patent, software or any other property right. Therefore,
+the Licensor disclaims any and all liability towards the Licensee
+arising out of any or all proceedings for infringement that may be
+instituted in respect of the use, modification and redistribution of the
+Software. Nevertheless, should such proceedings be instituted against
+the Licensee, the Licensor shall provide it with technical and legal
+assistance for its defense. Such technical and legal assistance shall be
+decided on a case-by-case basis between the relevant Licensor and the
+Licensee pursuant to a memorandum of understanding. The Licensor
+disclaims any and all liability as regards the Licensee's use of the
+name of the Software. No warranty is given as regards the existence of
+prior rights over the name of the Software or as regards the existence
+of a trademark.
+
+
+ Article 10 - TERMINATION
+
+10.1 In the event of a breach by the Licensee of its obligations
+hereunder, the Licensor may automatically terminate this Agreement
+thirty (30) days after notice has been sent to the Licensee and has
+remained ineffective.
+
+10.2 A Licensee whose Agreement is terminated shall no longer be
+authorized to use, modify or distribute the Software. However, any
+licenses that it may have granted prior to termination of the Agreement
+shall remain valid subject to their having been granted in compliance
+with the terms and conditions hereof.
+
+
+ Article 11 - MISCELLANEOUS
+
+
+ 11.1 EXCUSABLE EVENTS
+
+Neither Party shall be liable for any or all delay, or failure to
+perform the Agreement, that may be attributable to an event of force
+majeure, an act of God or an outside cause, such as defective
+functioning or interruptions of the electricity or telecommunications
+networks, network paralysis following a virus attack, intervention by
+government authorities, natural disasters, water damage, earthquakes,
+fire, explosions, strikes and labor unrest, war, etc.
+
+11.2 Any failure by either Party, on one or more occasions, to invoke
+one or more of the provisions hereof, shall under no circumstances be
+interpreted as being a waiver by the interested Party of its right to
+invoke said provision(s) subsequently.
+
+11.3 The Agreement cancels and replaces any or all previous agreements,
+whether written or oral, between the Parties and having the same
+purpose, and constitutes the entirety of the agreement between said
+Parties concerning said purpose. No supplement or modification to the
+terms and conditions hereof shall be effective as between the Parties
+unless it is made in writing and signed by their duly authorized
+representatives.
+
+11.4 In the event that one or more of the provisions hereof were to
+conflict with a current or future applicable act or legislative text,
+said act or legislative text shall prevail, and the Parties shall make
+the necessary amendments so as to comply with said act or legislative
+text. All other provisions shall remain effective. Similarly, invalidity
+of a provision of the Agreement, for any reason whatsoever, shall not
+cause the Agreement as a whole to be invalid.
+
+
+ 11.5 LANGUAGE
+
+The Agreement is drafted in both French and English and both versions
+are deemed authentic.
+
+
+ Article 12 - NEW VERSIONS OF THE AGREEMENT
+
+12.1 Any person is authorized to duplicate and distribute copies of this
+Agreement.
+
+12.2 So as to ensure coherence, the wording of this Agreement is
+protected and may only be modified by the authors of the License, who
+reserve the right to periodically publish updates or new versions of the
+Agreement, each with a separate number. These subsequent versions may
+address new issues encountered by Free Software.
+
+12.3 Any Software distributed under a given version of the Agreement may
+only be subsequently distributed under the same version of the Agreement
+or a subsequent version.
+
+
+ Article 13 - GOVERNING LAW AND JURISDICTION
+
+13.1 The Agreement is governed by French law. The Parties agree to
+endeavor to seek an amicable solution to any disagreements or disputes
+that may arise during the performance of the Agreement.
+
+13.2 Failing an amicable solution within two (2) months as from their
+occurrence, and unless emergency proceedings are necessary, the
+disagreements or disputes shall be referred to the Paris Courts having
+jurisdiction, by the more diligent Party.
+
+
+Version 1.0 dated 2006-09-05.
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
index 0000000000000000000000000000000000000000..43ff90f1d582a5a91f9e9a239d49bda3a934b0bb
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,516 @@
+CeCILL-C FREE SOFTWARE LICENSE AGREEMENT
+
+
+ Notice
+
+This Agreement is a Free Software license agreement that is the result
+of discussions between its authors in order to ensure compliance with
+the two main principles guiding its drafting:
+
+ * firstly, compliance with the principles governing the distribution
+ of Free Software: access to source code, broad rights granted to
+ users,
+ * secondly, the election of a governing law, French law, with which
+ it is conformant, both as regards the law of torts and
+ intellectual property law, and the protection that it offers to
+ both authors and holders of the economic rights over software.
+
+The authors of the CeCILL-C (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre])
+license are:
+
+Commissariat à l'Energie Atomique - CEA, a public scientific, technical
+and industrial research establishment, having its principal place of
+business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France.
+
+Centre National de la Recherche Scientifique - CNRS, a public scientific
+and technological establishment, having its principal place of business
+at 3 rue Michel-Ange, 75794 Paris cedex 16, France.
+
+Institut National de Recherche en Informatique et en Automatique -
+INRIA, a public scientific and technological establishment, having its
+principal place of business at Domaine de Voluceau, Rocquencourt, BP
+105, 78153 Le Chesnay cedex, France.
+
+
+ Preamble
+
+The purpose of this Free Software license agreement is to grant users
+the right to modify and re-use the software governed by this license.
+
+The exercising of this right is conditional upon the obligation to make
+available to the community the modifications made to the source code of
+the software so as to contribute to its evolution.
+
+In consideration of access to the source code and the rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty and the software's author, the holder of the
+economic rights, and the successive licensors only have limited liability.
+
+In this respect, the risks associated with loading, using, modifying
+and/or developing or reproducing the software by the user are brought to
+the user's attention, given its Free Software status, which may make it
+complicated to use, with the result that its use is reserved for
+developers and experienced professionals having in-depth computer
+knowledge. Users are therefore encouraged to load and test the
+suitability of the software as regards their requirements in conditions
+enabling the security of their systems and/or data to be ensured and,
+more generally, to use and operate it in the same conditions of
+security. This Agreement may be freely reproduced and published,
+provided it is not altered, and that no provisions are either added or
+removed herefrom.
+
+This Agreement may apply to any or all software for which the holder of
+the economic rights decides to submit the use thereof to its provisions.
+
+
+ Article 1 - DEFINITIONS
+
+For the purpose of this Agreement, when the following expressions
+commence with a capital letter, they shall have the following meaning:
+
+Agreement: means this license agreement, and its possible subsequent
+versions and annexes.
+
+Software: means the software in its Object Code and/or Source Code form
+and, where applicable, its documentation, "as is" when the Licensee
+accepts the Agreement.
+
+Initial Software: means the Software in its Source Code and possibly its
+Object Code form and, where applicable, its documentation, "as is" when
+it is first distributed under the terms and conditions of the Agreement.
+
+Modified Software: means the Software modified by at least one
+Integrated Contribution.
+
+Source Code: means all the Software's instructions and program lines to
+which access is required so as to modify the Software.
+
+Object Code: means the binary files originating from the compilation of
+the Source Code.
+
+Holder: means the holder(s) of the economic rights over the Initial
+Software.
+
+Licensee: means the Software user(s) having accepted the Agreement.
+
+Contributor: means a Licensee having made at least one Integrated
+Contribution.
+
+Licensor: means the Holder, or any other individual or legal entity, who
+distributes the Software under the Agreement.
+
+Integrated Contribution: means any or all modifications, corrections,
+translations, adaptations and/or new functions integrated into the
+Source Code by any or all Contributors.
+
+Related Module: means a set of sources files including their
+documentation that, without modification to the Source Code, enables
+supplementary functions or services in addition to those offered by the
+Software.
+
+Derivative Software: means any combination of the Software, modified or
+not, and of a Related Module.
+
+Parties: mean both the Licensee and the Licensor.
+
+These expressions may be used both in singular and plural form.
+
+
+ Article 2 - PURPOSE
+
+The purpose of the Agreement is the grant by the Licensor to the
+Licensee of a non-exclusive, transferable and worldwide license for the
+Software as set forth in Article 5 hereinafter for the whole term of the
+protection granted by the rights over said Software.
+
+
+ Article 3 - ACCEPTANCE
+
+3.1 The Licensee shall be deemed as having accepted the terms and
+conditions of this Agreement upon the occurrence of the first of the
+following events:
+
+ * (i) loading the Software by any or all means, notably, by
+ downloading from a remote server, or by loading from a physical
+ medium;
+ * (ii) the first time the Licensee exercises any of the rights
+ granted hereunder.
+
+3.2 One copy of the Agreement, containing a notice relating to the
+characteristics of the Software, to the limited warranty, and to the
+fact that its use is restricted to experienced users has been provided
+to the Licensee prior to its acceptance as set forth in Article 3.1
+hereinabove, and the Licensee hereby acknowledges that it has read and
+understood it.
+
+
+ Article 4 - EFFECTIVE DATE AND TERM
+
+
+ 4.1 EFFECTIVE DATE
+
+The Agreement shall become effective on the date when it is accepted by
+the Licensee as set forth in Article 3.1.
+
+
+ 4.2 TERM
+
+The Agreement shall remain in force for the entire legal term of
+protection of the economic rights over the Software.
+
+
+ Article 5 - SCOPE OF RIGHTS GRANTED
+
+The Licensor hereby grants to the Licensee, who accepts, the following
+rights over the Software for any or all use, and for the term of the
+Agreement, on the basis of the terms and conditions set forth hereinafter.
+
+Besides, if the Licensor owns or comes to own one or more patents
+protecting all or part of the functions of the Software or of its
+components, the Licensor undertakes not to enforce the rights granted by
+these patents against successive Licensees using, exploiting or
+modifying the Software. If these patents are transferred, the Licensor
+undertakes to have the transferees subscribe to the obligations set
+forth in this paragraph.
+
+
+ 5.1 RIGHT OF USE
+
+The Licensee is authorized to use the Software, without any limitation
+as to its fields of application, with it being hereinafter specified
+that this comprises:
+
+ 1. permanent or temporary reproduction of all or part of the Software
+ by any or all means and in any or all form.
+
+ 2. loading, displaying, running, or storing the Software on any or
+ all medium.
+
+ 3. entitlement to observe, study or test its operation so as to
+ determine the ideas and principles behind any or all constituent
+ elements of said Software. This shall apply when the Licensee
+ carries out any or all loading, displaying, running, transmission
+ or storage operation as regards the Software, that it is entitled
+ to carry out hereunder.
+
+
+ 5.2 RIGHT OF MODIFICATION
+
+The right of modification includes the right to translate, adapt,
+arrange, or make any or all modifications to the Software, and the right
+to reproduce the resulting software. It includes, in particular, the
+right to create a Derivative Software.
+
+The Licensee is authorized to make any or all modification to the
+Software provided that it includes an explicit notice that it is the
+author of said modification and indicates the date of the creation thereof.
+
+
+ 5.3 RIGHT OF DISTRIBUTION
+
+In particular, the right of distribution includes the right to publish,
+transmit and communicate the Software to the general public on any or
+all medium, and by any or all means, and the right to market, either in
+consideration of a fee, or free of charge, one or more copies of the
+Software by any means.
+
+The Licensee is further authorized to distribute copies of the modified
+or unmodified Software to third parties according to the terms and
+conditions set forth hereinafter.
+
+
+ 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION
+
+The Licensee is authorized to distribute true copies of the Software in
+Source Code or Object Code form, provided that said distribution
+complies with all the provisions of the Agreement and is accompanied by:
+
+ 1. a copy of the Agreement,
+
+ 2. a notice relating to the limitation of both the Licensor's
+ warranty and liability as set forth in Articles 8 and 9,
+
+and that, in the event that only the Object Code of the Software is
+redistributed, the Licensee allows effective access to the full Source
+Code of the Software at a minimum during the entire period of its
+distribution of the Software, it being understood that the additional
+cost of acquiring the Source Code shall not exceed the cost of
+transferring the data.
+
+
+ 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE
+
+When the Licensee makes an Integrated Contribution to the Software, the
+terms and conditions for the distribution of the resulting Modified
+Software become subject to all the provisions of this Agreement.
+
+The Licensee is authorized to distribute the Modified Software, in
+source code or object code form, provided that said distribution
+complies with all the provisions of the Agreement and is accompanied by:
+
+ 1. a copy of the Agreement,
+
+ 2. a notice relating to the limitation of both the Licensor's
+ warranty and liability as set forth in Articles 8 and 9,
+
+and that, in the event that only the object code of the Modified
+Software is redistributed, the Licensee allows effective access to the
+full source code of the Modified Software at a minimum during the entire
+period of its distribution of the Modified Software, it being understood
+that the additional cost of acquiring the source code shall not exceed
+the cost of transferring the data.
+
+
+ 5.3.3 DISTRIBUTION OF DERIVATIVE SOFTWARE
+
+When the Licensee creates Derivative Software, this Derivative Software
+may be distributed under a license agreement other than this Agreement,
+subject to compliance with the requirement to include a notice
+concerning the rights over the Software as defined in Article 6.4.
+In the event the creation of the Derivative Software required modification
+of the Source Code, the Licensee undertakes that:
+
+ 1. the resulting Modified Software will be governed by this Agreement,
+ 2. the Integrated Contributions in the resulting Modified Software
+ will be clearly identified and documented,
+ 3. the Licensee will allow effective access to the source code of the
+ Modified Software, at a minimum during the entire period of
+ distribution of the Derivative Software, such that such
+ modifications may be carried over in a subsequent version of the
+ Software; it being understood that the additional cost of
+ purchasing the source code of the Modified Software shall not
+ exceed the cost of transferring the data.
+
+
+ 5.3.4 COMPATIBILITY WITH THE CeCILL LICENSE
+
+When a Modified Software contains an Integrated Contribution subject to
+the CeCILL license agreement, or when a Derivative Software contains a
+Related Module subject to the CeCILL license agreement, the provisions
+set forth in the third item of Article 6.4 are optional.
+
+
+ Article 6 - INTELLECTUAL PROPERTY
+
+
+ 6.1 OVER THE INITIAL SOFTWARE
+
+The Holder owns the economic rights over the Initial Software. Any or
+all use of the Initial Software is subject to compliance with the terms
+and conditions under which the Holder has elected to distribute its work
+and no one shall be entitled to modify the terms and conditions for the
+distribution of said Initial Software.
+
+The Holder undertakes that the Initial Software will remain ruled at
+least by this Agreement, for the duration set forth in Article 4.2.
+
+
+ 6.2 OVER THE INTEGRATED CONTRIBUTIONS
+
+The Licensee who develops an Integrated Contribution is the owner of the
+intellectual property rights over this Contribution as defined by
+applicable law.
+
+
+ 6.3 OVER THE RELATED MODULES
+
+The Licensee who develops a Related Module is the owner of the
+intellectual property rights over this Related Module as defined by
+applicable law and is free to choose the type of agreement that shall
+govern its distribution under the conditions defined in Article 5.3.3.
+
+
+ 6.4 NOTICE OF RIGHTS
+
+The Licensee expressly undertakes:
+
+ 1. not to remove, or modify, in any manner, the intellectual property
+ notices attached to the Software;
+
+ 2. to reproduce said notices, in an identical manner, in the copies
+ of the Software modified or not;
+
+ 3. to ensure that use of the Software, its intellectual property
+ notices and the fact that it is governed by the Agreement is
+ indicated in a text that is easily accessible, specifically from
+ the interface of any Derivative Software.
+
+The Licensee undertakes not to directly or indirectly infringe the
+intellectual property rights of the Holder and/or Contributors on the
+Software and to take, where applicable, vis-Ã -vis its staff, any and all
+measures required to ensure respect of said intellectual property rights
+of the Holder and/or Contributors.
+
+
+ Article 7 - RELATED SERVICES
+
+7.1 Under no circumstances shall the Agreement oblige the Licensor to
+provide technical assistance or maintenance services for the Software.
+
+However, the Licensor is entitled to offer this type of services. The
+terms and conditions of such technical assistance, and/or such
+maintenance, shall be set forth in a separate instrument. Only the
+Licensor offering said maintenance and/or technical assistance services
+shall incur liability therefor.
+
+7.2 Similarly, any Licensor is entitled to offer to its licensees, under
+its sole responsibility, a warranty, that shall only be binding upon
+itself, for the redistribution of the Software and/or the Modified
+Software, under terms and conditions that it is free to decide. Said
+warranty, and the financial terms and conditions of its application,
+shall be subject of a separate instrument executed between the Licensor
+and the Licensee.
+
+
+ Article 8 - LIABILITY
+
+8.1 Subject to the provisions of Article 8.2, the Licensee shall be
+entitled to claim compensation for any direct loss it may have suffered
+from the Software as a result of a fault on the part of the relevant
+Licensor, subject to providing evidence thereof.
+
+8.2 The Licensor's liability is limited to the commitments made under
+this Agreement and shall not be incurred as a result of in particular:
+(i) loss due the Licensee's total or partial failure to fulfill its
+obligations, (ii) direct or consequential loss that is suffered by the
+Licensee due to the use or performance of the Software, and (iii) more
+generally, any consequential loss. In particular the Parties expressly
+agree that any or all pecuniary or business loss (i.e. loss of data,
+loss of profits, operating loss, loss of customers or orders,
+opportunity cost, any disturbance to business activities) or any or all
+legal proceedings instituted against the Licensee by a third party,
+shall constitute consequential loss and shall not provide entitlement to
+any or all compensation from the Licensor.
+
+
+ Article 9 - WARRANTY
+
+9.1 The Licensee acknowledges that the scientific and technical
+state-of-the-art when the Software was distributed did not enable all
+possible uses to be tested and verified, nor for the presence of
+possible defects to be detected. In this respect, the Licensee's
+attention has been drawn to the risks associated with loading, using,
+modifying and/or developing and reproducing the Software which are
+reserved for experienced users.
+
+The Licensee shall be responsible for verifying, by any or all means,
+the suitability of the product for its requirements, its good working
+order, and for ensuring that it shall not cause damage to either persons
+or properties.
+
+9.2 The Licensor hereby represents, in good faith, that it is entitled
+to grant all the rights over the Software (including in particular the
+rights set forth in Article 5).
+
+9.3 The Licensee acknowledges that the Software is supplied "as is" by
+the Licensor without any other express or tacit warranty, other than
+that provided for in Article 9.2 and, in particular, without any warranty
+as to its commercial value, its secured, safe, innovative or relevant
+nature.
+
+Specifically, the Licensor does not warrant that the Software is free
+from any error, that it will operate without interruption, that it will
+be compatible with the Licensee's own equipment and software
+configuration, nor that it will meet the Licensee's requirements.
+
+9.4 The Licensor does not either expressly or tacitly warrant that the
+Software does not infringe any third party intellectual property right
+relating to a patent, software or any other property right. Therefore,
+the Licensor disclaims any and all liability towards the Licensee
+arising out of any or all proceedings for infringement that may be
+instituted in respect of the use, modification and redistribution of the
+Software. Nevertheless, should such proceedings be instituted against
+the Licensee, the Licensor shall provide it with technical and legal
+assistance for its defense. Such technical and legal assistance shall be
+decided on a case-by-case basis between the relevant Licensor and the
+Licensee pursuant to a memorandum of understanding. The Licensor
+disclaims any and all liability as regards the Licensee's use of the
+name of the Software. No warranty is given as regards the existence of
+prior rights over the name of the Software or as regards the existence
+of a trademark.
+
+
+ Article 10 - TERMINATION
+
+10.1 In the event of a breach by the Licensee of its obligations
+hereunder, the Licensor may automatically terminate this Agreement
+thirty (30) days after notice has been sent to the Licensee and has
+remained ineffective.
+
+10.2 A Licensee whose Agreement is terminated shall no longer be
+authorized to use, modify or distribute the Software. However, any
+licenses that it may have granted prior to termination of the Agreement
+shall remain valid subject to their having been granted in compliance
+with the terms and conditions hereof.
+
+
+ Article 11 - MISCELLANEOUS
+
+
+ 11.1 EXCUSABLE EVENTS
+
+Neither Party shall be liable for any or all delay, or failure to
+perform the Agreement, that may be attributable to an event of force
+majeure, an act of God or an outside cause, such as defective
+functioning or interruptions of the electricity or telecommunications
+networks, network paralysis following a virus attack, intervention by
+government authorities, natural disasters, water damage, earthquakes,
+fire, explosions, strikes and labor unrest, war, etc.
+
+11.2 Any failure by either Party, on one or more occasions, to invoke
+one or more of the provisions hereof, shall under no circumstances be
+interpreted as being a waiver by the interested Party of its right to
+invoke said provision(s) subsequently.
+
+11.3 The Agreement cancels and replaces any or all previous agreements,
+whether written or oral, between the Parties and having the same
+purpose, and constitutes the entirety of the agreement between said
+Parties concerning said purpose. No supplement or modification to the
+terms and conditions hereof shall be effective as between the Parties
+unless it is made in writing and signed by their duly authorized
+representatives.
+
+11.4 In the event that one or more of the provisions hereof were to
+conflict with a current or future applicable act or legislative text,
+said act or legislative text shall prevail, and the Parties shall make
+the necessary amendments so as to comply with said act or legislative
+text. All other provisions shall remain effective. Similarly, invalidity
+of a provision of the Agreement, for any reason whatsoever, shall not
+cause the Agreement as a whole to be invalid.
+
+
+ 11.5 LANGUAGE
+
+The Agreement is drafted in both French and English and both versions
+are deemed authentic.
+
+
+ Article 12 - NEW VERSIONS OF THE AGREEMENT
+
+12.1 Any person is authorized to duplicate and distribute copies of this
+Agreement.
+
+12.2 So as to ensure coherence, the wording of this Agreement is
+protected and may only be modified by the authors of the License, who
+reserve the right to periodically publish updates or new versions of the
+Agreement, each with a separate number. These subsequent versions may
+address new issues encountered by Free Software.
+
+12.3 Any Software distributed under a given version of the Agreement may
+only be subsequently distributed under the same version of the Agreement
+or a subsequent version.
+
+
+ Article 13 - GOVERNING LAW AND JURISDICTION
+
+13.1 The Agreement is governed by French law. The Parties agree to
+endeavor to seek an amicable solution to any disagreements or disputes
+that may arise during the performance of the Agreement.
+
+13.2 Failing an amicable solution within two (2) months as from their
+occurrence, and unless emergency proceedings are necessary, the
+disagreements or disputes shall be referred to the Paris Courts having
+jurisdiction, by the more diligent Party.
+
+
+Version 1.0 dated 2006-09-05.
diff --git a/NAMESPACE b/NAMESPACE
index 7545b745280cabc17f597fbd10f919db5f9b14c0..2e83785258092dc4061d36b9dd19b36919173d8b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,38 +1,75 @@
# Generated by roxygen2: do not edit by hand
+export("%>%")
export(build_E_random)
export(build_gdata)
export(build_ldata)
export(build_mMov)
+export(build_prev_control)
export(build_transitions)
-export(cleanmeteo)
+export(estim_K)
+export(filter_meteo)
export(iniState)
-export(runArboRisk)
-import(data.table)
-import(igraph)
+export(plot_TS)
+export(run_arbocartoR)
importFrom(SimInf,mparse)
importFrom(SimInf,run)
importFrom(SimInf,trajectory)
+importFrom(TDLM,calib_param)
importFrom(TDLM,check_format_names)
importFrom(TDLM,extract_opportunities)
importFrom(TDLM,extract_spatial_information)
importFrom(TDLM,run_law)
+importFrom(TDLM,run_model)
+importFrom(data.table,.SD)
+importFrom(data.table,`:=`)
importFrom(data.table,as.IDate)
-importFrom(dplyr,anti_join)
-importFrom(fields,image.plot)
-importFrom(igraph,as_adjacency_matrix)
-importFrom(igraph,erdos.renyi.game)
-importFrom(imputeTS,na_ma)
+importFrom(data.table,as.data.table)
+importFrom(data.table,copy)
+importFrom(data.table,data.table)
+importFrom(data.table,is.data.table)
+importFrom(data.table,mday)
+importFrom(data.table,month)
+importFrom(data.table,rbindlist)
+importFrom(data.table,setDT)
+importFrom(data.table,setattr)
+importFrom(data.table,setcolorder)
+importFrom(data.table,setnames)
+importFrom(dygraphs,dySeries)
+importFrom(dygraphs,dygraph)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
+importFrom(magrittr,divide_by)
+importFrom(magrittr,equals)
importFrom(magrittr,is_greater_than)
-importFrom(magrittr,is_less_than)
+importFrom(magrittr,is_in)
+importFrom(magrittr,multiply_by)
+importFrom(magrittr,not)
importFrom(magrittr,subtract)
-importFrom(parallel,clusterEvalQ)
-importFrom(parallel,clusterExport)
-importFrom(parallel,detectCores)
-importFrom(parallel,makeCluster)
-importFrom(parallel,stopCluster)
importFrom(pbapply,pbapply)
importFrom(pbapply,pblapply)
-importFrom(zoo,rollapply)
+importFrom(sf,st_as_sf)
+importFrom(shiny,incProgress)
+importFrom(shiny,isRunning)
+importFrom(shiny,withProgress)
+importFrom(stats,aggregate)
+importFrom(stats,na.omit)
+importFrom(stats,quantile)
+importFrom(stats,rmultinom)
+importFrom(terra,activeCat)
+importFrom(terra,addCats)
+importFrom(terra,aggregate)
+importFrom(terra,buffer)
+importFrom(terra,crop)
+importFrom(terra,crs)
+importFrom(terra,erase)
+importFrom(terra,expanse)
+importFrom(terra,is.related)
+importFrom(terra,levels)
+importFrom(terra,mask)
+importFrom(terra,project)
+importFrom(terra,rast)
+importFrom(terra,relate)
+importFrom(terra,vect)
+importFrom(terra,zonal)
+importFrom(utils,capture.output)
diff --git a/R/build_E_random.R b/R/build_E_random.R
index d66a60e8f8259bb8f292d3d7ea6f8f2352a6cd6d..9d0267f20811086c00599d689d20c804e0032940 100644
--- a/R/build_E_random.R
+++ b/R/build_E_random.R
@@ -1,72 +1,108 @@
-#' Generate the list of introduction event
+#' Generate a list of introduction events
#'
-#' @description Function used to generate the random introduction.
-#' The introduction events generated can occurs in different locations and at different dates in a given period.
-#' The number of individuals introduced and their epidemiological stages can be deterministic (unique value provided) or random (randomly selected in a vector of values).
+#' @description Function used to generate a random list of schedule introduction.
+#' The introduction events generated can occur in different locations and at different dates in a given period.
+#' The number of individuals introduced is randomly distributed over all the events.
+#' If the number of events is not provided, location and date are randomly sampled for each introduced individual.
+#' The epidemiological stage can be either deterministic (unique value provided) or random (randomly selected in a vector of values).
#'
-#' @usage build_E_random(period_start, period_end, n_ind = 1, n_events = 1, stage = "Eh", loc)
+#' @param period_start Date in '\%Y-\%m-\%d' format. Defines the beginning of the period for introduction.
+#' @param period_end Date in '\%Y-\%m-\%d' format. Defines the end of the period for introduction.
+#' @param n_events Numeric value. Number of introduction events generated.
+#' @param n_ind Numeric value. Number of individuals introduced.
+#' @param stage Character vector. Epidemiological stage of introduced individuals.
+#' @param loc Character or numeric vector. List of patches to seed random introductions.
#'
-#' @param period_start date in '\%Y-\%m-\%d' format. Define the beginning of the period for introduction.
-#' @param period_end date in '\%Y-\%m-\%d' format. Define the end of the period for introduction.
-#' @param n_ind Numerical vector. Range of number of individuals introduced.
-#' @param n_events String vector. Number of introduction generated.
-#' @param stage String vector. Epidemiological stage of introduced individuals.
-#' @param loc String or numerical vector. List of patch to seed random introductions.
+#' @return Data frame with scheduled introductions.
#'
-#'
-#' @return events matrix with scheduled introductions
+#' @importFrom stats aggregate rmultinom
#'
#' @keywords events
#'
#' @examples
-#' build_E_random(period_start = as.Date("2020/03/10"), period_end = as.Date("2020/09/30"), n_ind = 1, n_events = 10, stage = "Eh", loc = LETTERS[1:3])
+#' \dontrun{
+#' build_E_random(period_start = as.Date("2020/03/10"),
+#' period_end = as.Date("2020/09/30"),
+#' n_ind = NULL, n_events = 10,
+#' stage = "Eh", loc = LETTERS[1:3])
+#' }
#'
#' @export
-build_E_random <- function( period_start,
- period_end,
- n_ind = 1,
- n_events = 1,
- stage = "Eh",
- loc){
+build_E_random <- function(period_start,
+ period_end = period_start,
+ n_events = NULL,
+ n_ind = NULL,
+ stage = "Eh",
+ loc) {
###
### Checks
###
- if(!inherits(period_start, "Date") | !inherits(period_end, "Date"))
+ if (!inherits(period_start, "Date") || !inherits(period_end, "Date")) {
stop("start and end dates must be dates ('Date' class)")
+ }
+ if (is.null(n_events) & is.null(n_ind)) stop("n_ind or n_events must be provided")
- if(!inherits(n_ind, c("integer","numeric")))
- stop("n_ind must be numeric")
-
- if(!inherits(n_events, "numeric") | length(n_events) != 1 )
- stop("n_events must be a unique numeric value")
+ if (is.null(n_ind)) n_ind <- n_events
- list_compartments() %>% .$u0
+ if (!is.null(n_events)) {
+ if (!inherits(n_events, c("numeric", "integer")) || length(n_events) != 1) {
+ stop("n_events must be a unique numeric value")
+ }
- if(! inherits(stage, "character") | sum(is.na(match(stage, list_compartments() %>% .$u0))) > 0)
- stop(paste(c("stage must be a character vector. Authorized entries:", list_compartments() %>% .$u0), collapse = " "))
+ if (n_ind < n_events) {
+ stop("n_ind must be greater than or equal to n_events")
+ }
+ }
- ###
+ if (!inherits(n_ind, c("integer", "numeric")) || length(n_ind) != 1) {
+ stop("n_ind must be numeric")
+ }
- period <- seq(period_start, period_end, by = "day")
+ list_compartments <- list_compartments()$u0
- if(length(period) < n_events) stop("The number of events cannot exceed the number of days in the period")
+ if (!inherits(stage, "character") || sum(is.na(match(stage, list_compartments))) > 0) {
+ stop(paste(c("stage must be a character vector. Authorized entries:", list_compartments), collapse = " "))
+ }
+ ###
+ period <- seq(period_start, period_end, by = "day")
###
###
- # sample time, location and number of individuals
- sampling <- expand.grid(period, loc, n_ind, stage)
- sampling <- sampling[sample(seq(nrow(sampling)), n_events),]
+ # sample time, location, and number of individuals
+ # every possible introduction
+ sampling <- expand.grid(period, loc, 1, stage)
+
+ # sample date and loc based on the number of events
+ if (is.null(n_events)) {
+ sampling <- sampling[sample(seq(nrow(sampling)), n_ind, replace = TRUE), ]
+ sampling <- aggregate(Var3 ~ ., data = sampling, sum)
+ } else if (n_events == n_ind) {
+ if (nrow(sampling) < n_events) {
+ stop("The number of events cannot exceed the number of days in the period times the number of possible locations for introduction")
+ }
+ sampling <- sampling[sample(seq(nrow(sampling)), n_ind, replace = FALSE), ]
+ } else {
+ if (nrow(sampling) < n_events) {
+ stop("The number of events cannot exceed the number of days in the period times the number of possible locations for introduction")
+ }
+ sampling <- sampling[sample(seq(nrow(sampling)), n_events, replace = FALSE), ]
+
+ # distribute individuals over events
+ distribution <- rmultinom(n = 1, size = n_ind, prob = rep(1 / n_events, n_events))
+ while (0 %in% distribution) distribution <- rmultinom(n = 1, size = n_ind, prob = rep(1 / n_events, n_events))
+ sampling$Var3 <- distribution
+ }
-events <- data.frame(
- time = sampling$Var1, ## The time that the event happens
- dest = sampling$Var2, ## In which node does the event occur
- n = sampling$Var3, ## How many individuals are moved
- select = sampling$Var4 ## Use the 4th column in the model select matrix
+ events <- data.frame(
+ time = sampling$Var1, # The time that the event happens
+ dest = sampling$Var2, # In which node does the event occur
+ n = sampling$Var3, # How many individuals are moved
+ select = sampling$Var4 # Use the 4th column in the model select matrix
)
-return(events)
+ return(events)
}
diff --git a/R/build_gdata.R b/R/build_gdata.R
index 3e33815a7b12bd942ec33d8a032d75365786b9de..4cf65ed2ec1ac91314ffdf598eeca894cf6ff1b9 100644
--- a/R/build_gdata.R
+++ b/R/build_gdata.R
@@ -3,63 +3,114 @@
#' @description
#' The functions formats all global parameters required for the model.
#'
-#' @usage build_gdata()
-#'
-#' @importFrom magrittr %>%
-#'
-#' @param vector_species string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.
-#' @param climat string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.
+#' @param vector string. "Ae. albopictus", "Ae. albopictus (D)" or "Ae. aegypti". Default is "Ae. albopictus (D)".
+#' @param virus string. "DEN" (dengue), "ZIK" (zika) or "CHI" (chikungunya). Default is "DEN" (dengue) virus.
#'
+#' @param bHM numeric. Probability of infection from host to vector when an infected host is bitten by an susceptible vector
#' @param bMH numeric. Probability of infection from vector to host when a human is bitten by an infected mosquito.
-#' @param bHM numeric. Probability of infection from host to vector when an infected human is bitten by an susceptible mosquito.
#' @param muH numeric. Daily transition rate from exposed (E) to infected (I) for humans (1/days)
#' @param rhoH numeric. Daily recovery rate of humans (1/days)
#'
#' @param muE numeric. Daily mortality rate of eggs (1/days)
-#' @param TE numeric. Minimal temperature needed for egg development (°C)
-#' @param TDDE numeric. Total number of degree-day necessary for egg development (°C)
#'
-#' @param mu1L numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}
-#' @param mu2L numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}
-#' @param mu3L numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}
+#' @param TE numeric. Minimal temperature needed for albopictus eggs development (°C) (see details of albopictus functions)
+#' @param TDDE numeric. Total number of degree-day necessary for albopictus eggs development (°C) (see details of albopictus functions)
+#'
+#' @param q1E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#' @param q2E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#' @param q3E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#' @param q4E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#' @param q5E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#' @param q6E numeric. Parameter for the aegypti egg development function (see details of aegypti functions)
+#'
+#' @param mu1L numeric. Parameter for the larvae mortality function (see details)
+#' @param mu2L numeric. Parameter for the larvae mortality function (see details)
+#' @param mu3L numeric. Parameter for the larvae mortality function (see details)
#'
-#' @param q1L numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}
-#' @param q2L numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}
-#' @param q3L numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}
+#' @param q1L numeric. Parameter for the function of transition from larva to pupa (see details)
+#' @param q2L numeric. Parameter for the function of transition from larva to pupa (see details)
+#' @param q3L numeric. Parameter for the function of transition from larva to pupa (see details)
+#' @param q4L numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)
+#' @param q5L numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)
+#' @param q6L numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)
#'
-#' @param mu1P numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}
-#' @param mu2P numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}
-#' @param mu3P numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}
+#' @param mu1P numeric. Parameter for the pupae mortality function (see details)
+#' @param mu2P numeric. Parameter for the pupae mortality function (see details)
+#' @param mu3P numeric. Parameter for the pupae mortality function (see details)
#'
#' @param muEM numeric. Daily mortality rate of emerging adults during the emergence (1/days)
#'
-#' @param q1P numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}
-#' @param q2P numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}
-#' @param q3P numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}
+#' @param q1P numeric. Parameter for the function of transition from pupae to emerging adult (see details)
+#' @param q2P numeric. Parameter for the function of transition from pupae to emerging adult (see details)
+#' @param q3P numeric. Parameter for the function of transition from pupae to emerging adult (see details)
+#' @param q4P numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)
+#' @param q5P numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)
+#' @param q6P numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)
#'
#' @param mu1A numeric. Parameter for the adult mortality function: \eqn{mu1A \times e^{(temperature_{t}-10) \times mu2A} + mu3A}
#' @param mu2A numeric. Parameter for the adult mortality function: \eqn{mu1A \times e^{(temperature_{t}-10) \times mu2A} + mu3A}
#' @param mu3A numeric. Parameter for the adult mortality function: \eqn{mu1A \times e^{(temperature_{t}-10) \times mu2A} + mu3A}
#'
-#'
#' @param gammaAem numeric. Daily development rate of emerging adults (1/days)
#' @param sigma numeric. Sex-ratio at the emergence
#'
#' @param gammaAh numeric. Daily transition rate from host-seeking to engorged adults (1/days)
#' @param muR numeric. Daily mortality rate related to seeking behavior (1/days)
#'
-#' @param TAG numeric. Minimal temperature needed for egg maturation (°C)
-#' @param TDDAG numeric. Total number of degree-days necessary for egg maturation (°C)
+#' @param TAG numeric. Minimal temperature needed for egg maturation (°C) (see details of albopictus functions)
+#' @param TDDAG numeric. Total number of degree-days necessary for egg maturation (°C) (see details of albopictus functions)
+#'
+#' @param q1Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
+#' @param q2Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
+#' @param q3Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
+#' @param q4Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
+#' @param q5Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
+#' @param q6Ag numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)
#'
#' @param gammaAo numeric. Daily transition rate from oviposition site-seeking to host-seeking adults (1/days)
#'
#' @param beta1 numeric. Number of eggs laid by ovipositing nulliparous females (per female)
#' @param beta2 numeric. Number of eggs laid by ovipositing parous females (per female)
#'
-#' @param startFav date. First day of the favorable period for the mosquito (depend on the species and the environment).
-#' @param endFav date. Last day of the favorable period for the mosquito (depend on the species and the environment).
+#' @param maxbite numeric. Maximal number of bite per human.
+#'
+#' @param startFav date. First day of the favorable period for diapausing mosquitos.
+#' @param endFav date. Last day of the favorable period for diapausing mosquitos.
+#'
+#' @param muErain numeric. Additional mortality of eggs due to heavy rain (> 80mm)
+#' @param muLrain numeric. Additional mortality of larvae due to heavy rain (> 80mm)
+#' @param muPrain numeric. Additional mortality of pupae due to heavy rain (> 80mm)
+#'
+#' @param verbose logical. Provide additional information on parameters during generation
+#'
+#' @details
+#' Aegypti (with \eqn{temperature\_K_{t}} the daily temperature in kalvin):
+#'
+#' egg development function: \eqn{(q1E \times temperature\_K_{t} \times q2E \times e^{(q4E - (1 / temperature\_K_{t}))}) / (1 + e^{q5E \times (q6E - 1 / temperature\_K_{t})})}
+#'
+#' transition function from larva to pupa: \eqn{(q1L \times temperature\_K_{t} \times q2L) \times e^{q3L \times (q4L - 1 / temperature\_K_{t})} / (1 + e^{q5L \times (q6L - 1 / temperature\_K_{t})})}
+#'
+#' transition function from pupa to emerging adult: \eqn{(q1P \times temperature\_K_{t} \times q2P) \times e^{q3P \times (q4P - 1 / temperature\_K_{t})} / (1 + e^{q5P \times (q6P- 1 / temperature\_K_{t})})}
#'
-#' @param verbose logical. Provide information on parameters during generation
+#' function for eggs maturation after blood meal: \eqn{(q1Ag \times temperature\_K_{t} \times q2Ag ) \times e^{q3Ag \times (q4Ag - 1 / temperature\_K_{t})} / (1 + e^{q5Ag \times (q6Ag - 1 / temperature\_K_{t})})}
+#'
+#' Albopictus (with \eqn{temperature\_C_{t}} the daily temperature in celsius degree):
+#'
+#' egg development function: \eqn{(temperature\_C_{t} - TE) / TDDE}
+#'
+#' larvae mortality function: \eqn{ mu1L \times e^{(temperature\_C_{t}-10) \times mu2L} + mu3L}
+#'
+#' transition function from larva to pupa: \eqn{q1L \times temperature\_C_{t}^{2} + q2L \times temperature\_C_{t}+ q3L}
+#'
+#' transition function from pupae to emerging adult: \eqn{q1P \times temperature\_C_{t}^{2} + q2P \times temperature\_C_{t} + q3P}
+#'
+#' function for eggs maturation after blood meal: \eqn{(temperature\_C_{t} - TAG )/ TDDAG}
+#'
+#' Both:
+#'
+#' Larvae mortality function: \eqn{(mu1L \times e^{(temperature\_C_{t} - 10)\times mu2L} + mu3L)\times (1 + Lm/kL)}, with Lm the number of larvae and kL the carrying capacity (density dependance)
+#'
+#' Pupae mortality function: \eqn{mu1P \times e^{(temperature\_C_{t}-10) \times mu2P} + mu3P}
#'
#' @return Named list of parameters
#'
@@ -68,8 +119,8 @@
#' @export
build_gdata <- function(
- vector_species = "Ae. albopictus",
- climate = "temperate",
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
##### Infection
# mosquitoes infection from host to vector
bHM = NULL,
@@ -80,8 +131,16 @@ build_gdata <- function(
rhoH = NULL, # Recovery rate of humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/4)
# eggs
muE = NULL,
+ ### albo specific
TE = NULL,
TDDE = NULL,
+ ### aegypti specific
+ q1E = NULL,
+ q2E = NULL,
+ q3E = NULL,
+ q4E = NULL,
+ q5E = NULL,
+ q6E = NULL,
# larva
mu1L = NULL,
mu2L = NULL,
@@ -89,6 +148,9 @@ build_gdata <- function(
q1L = NULL,
q2L = NULL,
q3L = NULL,
+ q4L = NULL,
+ q5L = NULL,
+ q6L = NULL,
muEM = NULL,
mu1P = NULL,
mu2P = NULL,
@@ -96,6 +158,9 @@ build_gdata <- function(
q1P = NULL,
q2P = NULL,
q3P = NULL,
+ q4P = NULL,
+ q5P = NULL,
+ q6P = NULL,
# emerging adults
mu1A = NULL,
mu2A = NULL,
@@ -106,32 +171,117 @@ build_gdata <- function(
gammaAh = NULL,
muR = NULL,
# engorged adults
+ ### albo specific
TAG = NULL,
TDDAG = NULL,
+ ### aegypti specific
+ q1Ag = NULL,
+ q2Ag = NULL,
+ q3Ag = NULL,
+ q4Ag = NULL,
+ q5Ag = NULL,
+ q6Ag = NULL,
# oviposition-site-seeking adults
gammaAo = NULL,
beta1 = NULL,
beta2 = NULL,
+ maxbite = NULL,
startFav = NULL,
endFav = NULL,
+ muErain = NULL,
+ muLrain = NULL,
+ muPrain = NULL,
verbose = T) {
- if(! vector_species %in% c(NULL, "Ae. albopictus"))
+ ### CHECKS
+
+ if(! vector %in% c("Ae. albopictus", "Ae. albopictus (D)", "Ae. aegypti"))
stop(
- "Only Ae. albopictus in temperate climate has been implemented yet, nevertheless all parameters can be modified."
+ "Only Ae. albopictus in both temperate ('Ae. albopictus (D)') and tropical environments ('Ae. albopictus') and
+ Ae. aegypti have been implemented yet, nevertheless all parameters can be modified."
)
- if(! climate %in% c(NULL, "temperate"))
+ if(! virus %in% c("DEN", "CHI", "ZIK"))
stop(
- "Only Ae. albopictus in temperate climate has been implemented yet, nevertheless all parameters can be modified."
+ "Only dengue ('DEN'), chikungunya ('CHI') and zika ('ZIK') virus are implemented yet, nevertheless all parameters can be modified."
)
- if(vector_species == "Ae. albopictus" & climate == "temperate"){
+ ### Defaults parameters
+
+ ### Intrinsic incubation
+
+ # zika >> 3 - 14 https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5403043/
+ # 6.8 https://www.ncbi.nlm.nih.gov/pmc/articles/PMC9803243/#pone.0270127
+
+ # chik >> 2 - 10 https://www.pasteur.fr/fr/centre-medical/fiches-maladies/chikungunya
+ # 3 - 7 https://www.ncid.sg/Health-Professionals/Diseases-and-Conditions/Pages/Chikungunya.aspx
+
+ # dengue >> 2 - 7 (Pasteur) ;
+ # 3 - 10 https://www.ncbi.nlm.nih.gov/pmc/articles/PMC3511440/
+ # 4–10 World Health Organization and Special Programme for Research and Training in Tropical Diseases (2009) Dengue: Guideline for diagnosis, treatment, prevention and control. France: World Health Organization.
+ # 3–14 Tomashek KM (2011) Dengue fever. CDC Health Information for International Travel 2012: The Yellow Book. USA: Oxford University Press. 156–161.
+ # 3-9 https://pubmed.ncbi.nlm.nih.gov/17330791/
+ # 3 - 10 https://www.cdc.gov/dengue/training/cme/ccm/page45915.html
+ # 5.9 https://www.sciencedirect.com/science/article/pii/S1755436517300907
+
+ ### Infectious period
+
+ # zika >> 10.8 https://www.ncbi.nlm.nih.gov/pmc/articles/PMC6137117/
+ # 10 https://www.ncbi.nlm.nih.gov/pmc/articles/PMC9803243/#pone.0270127
+ # 2 - 7 https://www.cdc.gov/zika/pdfs/clinicianppt.pdf
+ # 2 - 7 https://www.ecdc.europa.eu/en/zika-virus-infection/facts/factsheet
+
+ # chik >> 2 - 5 https://wwwnc.cdc.gov/travel/yellowbook/2024/infections-diseases/chikungunya
+ # 2 - 6 https://www.ncid.sg/Health-Professionals/Diseases-and-Conditions/Pages/Chikungunya.aspx
+
+ # dengue >> 7 https://www.cdc.gov/dengue/training/cme/ccm/page45915.html
+ # 4 - 7 https://wwwnc.cdc.gov/travel/yellowbook/2024/infections-diseases/dengue
+ # 4 - 10
+ # 5 https://academic.oup.com/jid/article/181/1/2/892842
+
+
+ ##### Infection human
+ if(virus == "DEN"){
+ # https://www.cdc.gov/dengue/training/cme/ccm/page45915.html
+ if(is.null(muH)) muH = 1/mean(c(3,10)) # Intrinsic Incubation Period (3-14 days) - Once bitten, DENV replicates in the human for 3–14 days. After incubation, the human can become ill.
+ if(is.null(rhoH)) rhoH = 1/7 # Infectious Period (about 7 days) - Both symptomatic and asymptomatic persons are viremic and can transmit DENV to mosquitoes that bite them during this approximately 7-day period. This viremic period is known as the "period of infectivity". In sick persons, viremia typically coincides with the presence of fever.
+ }
+
+ if(virus == "ZIK"){
+ # https://www.who.int/health-topics/zika-virus-disease#tab=tab_1
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC9803243/#pone.0270127.ref055
+ if(is.null(muH)) muH = 1/mean(c(3,14)) # Intrinsic Incubation Period (3-14 days)
+ if(is.null(rhoH)) rhoH = 1/7 # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC9803243/#pone.0270127.ref055 & https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5403043/
+ }
+
+ if(virus == "CHI"){
+ # https://www.cdc.gov/dengue/training/cme/ccm/page45915.html
+ if(is.null(muH)) muH = 1/mean(c(3, 7)) # Intrinsic Incubation Period (3-7 days)
+ if(is.null(rhoH)) rhoH = 1/mean(c(2, 6)) # Infectious Period: From up to 2 days before illness onset to 5 days after illness onset.
+ }
+
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+
##### Infection
- if(is.null(bMH)) bMH = 0.5
- # if(is.null(delta)) delta = 4.5
- if(is.null(muH)) muH = 1/5
- if(is.null(rhoH)) rhoH = 1/5
+ if(virus == "DEN"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4109365/
+ if(is.null(bMH)) bMH = 0.31
+ if(is.null(bHM)) bHM = 0.31
+ }
+ if(virus == "CHI"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4109365/
+ if(is.null(bMH)) bMH = 0.33
+ if(is.null(bHM)) bHM = 0.33
+ }
+ if(virus == "ZIK"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5963318/
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4911567/ - data from dengue paper below
+ # https://pubmed.ncbi.nlm.nih.gov/23139836/ (Dengue)
+ if(is.null(bMH)) bMH = 0.5
+ if(is.null(bHM)) bHM = 0.41
+ }
+
+ ## Mosquitoes life cycle
if(is.null(muE)) muE = 0.05
if(is.null(TE)) TE = 10
if(is.null(TDDE)) TDDE = 110
@@ -153,18 +303,108 @@ build_gdata <- function(
if(is.null(mu3A)) mu3A = 0.025
if(is.null(gammaAem)) gammaAem = 0.4
if(is.null(sigma)) sigma = 0.5
- if(is.null(gammaAh))gammaAh = 0.3
+ if(is.null(gammaAh)) gammaAh = 0.3
if(is.null(muR)) muR = 0.08
if(is.null(TAG)) TAG = 10
if(is.null(TDDAG)) TDDAG = 77
if(is.null(gammaAo)) gammaAo = 0.28
+
+ if(is.null(muErain)) muErain = 0.1
+ if(is.null(muLrain)) muLrain = 0.5
+ if(is.null(muPrain)) muPrain = 0.5
+ }
+
+ if(vector == "Ae. albopictus (D)")
+ {
if(is.null(beta1)) beta1 = 95
if(is.null(beta2)) beta2 = 75
- if(is.null(bHM)) bHM = 0.31
if(is.null(startFav)) startFav = as.Date("10/03/2020", format = "%d/%m/%Y")
if(is.null(endFav)) endFav = as.Date("30/09/2020", format = "%d/%m/%Y")
}
+ if(vector == "Ae. albopictus"){
+ if(is.null(beta1)) beta1 = 60
+ if(is.null(beta2)) beta2 = 80
+ }
+
+ if(vector == "Ae. aegypti"){
+
+ ##### Infection
+ if(virus == "DEN"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4109365/
+ if(is.null(bMH)) bMH = 0.33
+ if(is.null(bHM)) bHM = 0.33
+ }
+ if(virus == "CHI"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4109365/
+ if(is.null(bMH)) bMH = 0.24
+ if(is.null(bHM)) bHM = 0.24
+ }
+ if(virus == "ZIK"){
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC5963318/
+ # https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4911567/ - data from dengue paper below
+ # https://pubmed.ncbi.nlm.nih.gov/23139836/ (Dengue)
+ if(is.null(bMH)) bMH = 0.5
+ if(is.null(bHM)) bHM = 0.41
+ }
+
+ ## Mosquitoes life cycle
+ if(is.null(muE)) muE = 0.01
+ if(is.null(mu1L)) mu1L = 0.0007
+ if(is.null(mu2L)) mu2L = 0.1838
+ if(is.null(mu3L)) mu3L = 0.02
+ if(is.null(muEM)) muEM = 0.1
+ if(is.null(mu1P)) mu1P = 0.0003
+ if(is.null(mu2P)) mu2P = 0.2228
+ if(is.null(mu3P)) mu3P = 0.02
+ if(is.null(mu1A)) mu1A = 0.0003
+ if(is.null(mu2A)) mu2A = 0.1745
+ if(is.null(mu3A)) mu3A = 0.025
+ if(is.null(gammaAem)) gammaAem = 0.4
+ if(is.null(sigma)) sigma = 0.5
+ if(is.null(gammaAh)) gammaAh = 1.0
+ if(is.null(muR)) muR = 0.08
+ if(is.null(gammaAo)) gammaAo = 1.0
+ if(is.null(beta1)) beta1 = 60
+ if(is.null(beta2)) beta2 = 60
+
+ if(is.null(q1E)) q1E = 0.01066 / 298 #ro
+ if(is.null(q2E)) q2E = 24
+ if(is.null(q3E)) q3E = 1
+ if(is.null(q4E)) q4E = 0.0033557
+ if(is.null(q5E)) q5E = 100000.0 / 1.987 # deltaHH
+ if(is.null(q6E)) q6E = 1.0 / 14184.5 # T_12H
+
+ if(is.null(q1P)) q1P = 0.0161 / 298
+ if(is.null(q2P)) q2P = 24
+ if(is.null(q3P)) q3P = 14931.94 / 1.987
+ if(is.null(q4P)) q4P = 0.0033557
+ if(is.null(q5P)) q5P = -472379 / 1.987
+ if(is.null(q6P)) q6P = 1 / 148.45
+
+ if(is.null(q1L)) q1L = 0.00873 / 298
+ if(is.null(q2L)) q2L = 24
+ if(is.null(q3L)) q3L = 26018.51 / 1.987 # deltaHA
+ if(is.null(q4L)) q4L = 0.0033557
+ if(is.null(q5L)) q5L = 55990.75 / 1.987
+ if(is.null(q6L)) q6L = 1 / 304.58
+
+ if(is.null(q1Ag)) q1Ag = 0.00898 / 298
+ if(is.null(q2Ag)) q2Ag = 24
+ if(is.null(q3Ag)) q3Ag = 15725.23 / 1.987
+ if(is.null(q4Ag)) q4Ag = 0.0033557
+ if(is.null(q5Ag)) q5Ag = 1756481.07 / 1.987
+ if(is.null(q6Ag)) q6Ag = 1 / 447.17
+
+ if(is.null(muErain)) muErain = 0.1
+ if(is.null(muLrain)) muLrain = 0.2
+ if(is.null(muPrain)) muPrain = 0.2
+
+ }
+
+
+ if(is.null(maxbite)) maxbite = 3 ## FIX ME
+
### Checks
sapply(c(
@@ -177,23 +417,30 @@ build_gdata <- function(
gammaAh,
muR,
gammaAo,
- bHM
- ), function(x)
- if (x < 0 | x > 1)
- stop(
- paste(x, " must fall between 0 and 1.")
- ))
+ bHM,
+ muErain,
+ muLrain,
+ muPrain
+ ), function(x){
+ if(!is.null(x) & !inherits(x, 'function')){
+ if(x < 0 | x > 1)
+ stop(
+ paste(x, " must fall between 0 and 1.")
+ )}
+ })
- if(!is.null(startFav) & !is.null(startFav)){
- if(class(startFav) != "Date")
- startFav %<>% as.Date
+ if(vector == "Ae. albopictus (D)"){
+ if(!is.null(startFav) & !is.null(startFav)){
+ if(inherits(startFav,"Date"))
+ startFav %<>% as.Date
- if(class(endFav) != "Date")
- endFav %<>% as.Date
+ if(inherits(endFav, "Date"))
+ endFav %<>% as.Date
- if(verbose)
- message("Diapause period is from ", startFav, " to ", endFav)
+ if(verbose)
+ message("Diapause period is from ", format(endFav, "%m-%d"), " to ", format(startFav, "%m-%d"))
}
+ }
sapply(c(beta1, beta2), function(x)
if (x < 0)
@@ -201,52 +448,130 @@ build_gdata <- function(
"Number of eggs layed beta1 and beta2 must be positive numbers."
))
- gdata = list(
- # humans
- bMH = bMH, # Infection probability from vector to host - 0.5
- # delta = delta,
- muH = muH, # transition rate from exposed (E) to infected (I) for humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/2)
- rhoH = rhoH, # Recovery rate of humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/4)
- # eggs
- muE = muE,
- TE = TE, # 10.4 in Tran 2013
- TDDE = TDDE,
- # larva
- mu1L = mu1L,
- mu2L = mu2L,
- mu3L = mu3L,
- q1L = q1L,
- q2L = q2L,
- q3L = q3L,
- # pupa
- muEM = muEM,
- mu1P = mu1P,
- mu2P = mu2P,
- mu3P = mu3P,
- q1P = q1P,
- q2P = q2P,
- q3P = q3P,
- # emerging adults
- mu1A = mu1A,
- mu2A = mu2A,
- mu3A = mu3A,
- gammaAem = gammaAem,
- sigma = sigma, # proportion of females
- # host-seeking adults
- gammaAh = gammaAh, # 0.2 dans Tran 2013
- muR = muR,
- # engorged adults
- TAG = TAG,
- TDDAG = TDDAG,
- # oviposition-site-seeking adults
- gammaAo = gammaAo,
- beta1 = beta1,
- beta2 = beta2,
- # mosquitoes infection
- bHM = bHM,
- startFav = startFav,
- endFav = endFav
- )
+
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+ gdata = list(
+ # humans
+ bMH = bMH, # Infection probability from vector to host - 0.5
+ # delta = delta,
+ muH = muH, # transition rate from exposed (E) to infected (I) for humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/2)
+ rhoH = rhoH, # Recovery rate of humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/4)
+ # eggs
+ muE = muE,
+ TE = TE, # 10.4 in Tran 2013
+ TDDE = TDDE,
+ # larva
+ mu1L = mu1L,
+ mu2L = mu2L,
+ mu3L = mu3L,
+ q1L = q1L,
+ q2L = q2L,
+ q3L = q3L,
+ # pupa
+ muEM = muEM,
+ mu1P = mu1P,
+ mu2P = mu2P,
+ mu3P = mu3P,
+ q1P = q1P,
+ q2P = q2P,
+ q3P = q3P,
+ # emerging adults
+ mu1A = mu1A,
+ mu2A = mu2A,
+ mu3A = mu3A,
+ gammaAem = gammaAem,
+ sigma = sigma, # proportion of females
+ # host-seeking adults
+ gammaAh = gammaAh, # 0.2 dans Tran 2013
+ muR = muR,
+ # engorged adults
+ TAG = TAG,
+ TDDAG = TDDAG,
+ # oviposition-site-seeking adults
+ gammaAo = gammaAo,
+ beta1 = beta1,
+ beta2 = beta2,
+ maxbite = maxbite,
+ # mosquitoes infection
+ bHM = bHM,
+ muErain = muErain,
+ muLrain = muLrain,
+ muPrain = muPrain
+ )
+
+ if(vector == "Ae. albopictus (D)"){
+ gdata %<>% append(., list(
+ startFav = startFav,
+ endFav = endFav
+ ))
+ }
+
+ }
+
+
+ if(vector == "Ae. aegypti"){
+ gdata = list(
+ # humans
+ bMH = bMH, # Infection probability from vector to host - 0.5
+ # delta = delta,
+ muH = muH, # transition rate from exposed (E) to infected (I) for humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/2)
+ rhoH = rhoH, # Recovery rate of humans (1/days) (doi: 10.1038/s41598-019-53127-z : 1/4)
+ # mosquitoes infection
+ bHM = bHM,
+ ## Mosquitoes life cycle
+ muE = muE,
+ mu1L = mu1L,
+ mu2L = mu2L,
+ mu3L = mu3L,
+ muEM = muEM,
+ mu1P = mu1P,
+ mu2P = mu2P,
+ mu3P = mu3P,
+ mu1A = mu1A,
+ mu2A = mu2A,
+ mu3A = mu3A,
+ gammaAem = gammaAem,
+ sigma = sigma,
+ gammaAh = gammaAh,
+ muR = muR,
+ gammaAo = gammaAo,
+ beta1 = beta1,
+ beta2 = beta2,
+ maxbite = maxbite,
+
+ q1E = q1E,
+ q2E = q2E,
+ q3E = q3E,
+ q4E = q4E,
+ q5E = q5E,
+ q6E = q6E,
+
+ q1P = q1P,
+ q2P = q2P,
+ q3P = q3P,
+ q4P = q4P,
+ q5P = q5P,
+ q6P = q6P,
+
+ q1L = q1L,
+ q2L = q2L,
+ q3L = q3L,
+ q4L = q4L,
+ q5L = q5L,
+ q6L = q6L,
+
+ q1Ag = q1Ag,
+ q2Ag = q2Ag,
+ q3Ag = q3Ag,
+ q4Ag = q4Ag,
+ q5Ag = q5Ag,
+ q6Ag = q6Ag,
+
+ muErain = muErain,
+ muLrain = muLrain,
+ muPrain = muPrain
+ )
+ }
return(gdata)
diff --git a/R/build_ldata.R b/R/build_ldata.R
index e5085edf8b4eb894536769c2cb18b19b52cf0014..27a92617f1ab68da4a76c749820d42933be19490 100644
--- a/R/build_ldata.R
+++ b/R/build_ldata.R
@@ -1,134 +1,134 @@
#' Generate local parameters matrix
#'
#' @description
-#' The function computes and formats for each pacth the list of local parameters required by the model. Arguments related to the simulation are required to compile daily meteorological data for the simulated period.
+#' The function computes and formats for each patch the list of local parameters required by the model.
#'
-#' @usage build_ldata(PARCELLE, METEO)
+#' @param parcels data.frame or data.table describing the patches. Required columns: 'ID', 'POP', 'Kfix', 'Kvar', 'STATION' (optional), 'DIFF_ALT' (optional).
+#' @param meteo data.frame or data.table reporting daily meteorological data. Required columns: 'ID', 'DATE', 'RR', 'TP'.
+#' @param gdata list of parameters, can be generated using `build_gdata` function.
+#' @param vector string. Default is "Ae. albopictus (D)".
+#' @param virus string. Default is "DEN" (dengue virus).
+#' @param mMov list of two matrices for movement probabilities. Defaults to NULL, which means no movement.
+#' @param prev_control data.frame or data.table describing preventive control measures. Required columns: 'action', 'loc', 'start', 'end', 'p'.
+#' @param start_date date in 'Y-m-d' format. Defaults to the earliest date in the meteorological dataset.
+#' @param end_date date in 'Y-m-d' format. Defaults to the most recent date in the meteorological dataset.
+#' @param nYR_init numeric. Number of years used to initialize population dynamics. Default is 1.
#'
-#' @param PARCELLE data.frame or data.table describing the patches. Required columns: "ID": unique identifier, "POP": population size, "SURF_HA": surface in hectare, "KLfix": fix carrying capacity for larvae, "KLvar": variable carrying capacity for larvae, "KPfix": fix carrying capacity for pupae, "KPvar": variable carrying capacity for pupae, "STATION": meteorological station identifier, "DIFF_ALT": difference between meteorological station altitude and average altitude of the patch.
-#' @param METEO data.frame or data.table reporting the daily meteorological data for each meteorological station. Required columns: 'ÌD', 'DATE', 'RR': daily precipitation (mm), 'TP': daily mean temperature (°C)
-#' @param gdata list of parameters. Can be generated using `build_gdata` function
-#' @param vector_species string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date. Only needed if gdata is not provided.
-#' @param climat string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date. Only needed if gdata is not provided.
-#' @param mMov list of two matrices. Probabilities of location of individuals.
-#' proba_ij is the probabilities of individuals from i (columns) to be bitten in j (rows).
-#' proba_ji is the probabilities for mosquito in i (rows) to bite an individual from j (columns).
-#' Row sums should be equal to 1.
-#' @param start_date date in '\%Y-\%m-\%d' format. Starting date of the simulation. If not provided, the function uses the oldest date in the meteorological dataset.
-#' @param end_date date in '\%Y-\%m-\%d' format. Ending date of the simulation. If not provided, the function uses the most recent date in the meteorological dataset.
-#' @param nYR_init numerical value. Number of years used to initialize the population dynamics (default is 1).
+#' @return matrix of local parameters.
#'
-#'
-#' @importFrom SimInf mparse
-#' @importFrom SimInf run
-#' @importFrom SimInf trajectory
-#' @importFrom pbapply pblapply
-#' @importFrom dplyr anti_join
-#' @importFrom magrittr %<>%
-#' @importFrom magrittr is_greater_than
-#'
-#' @return matrix
+#' @importFrom pbapply pbapply
#'
#' @export
-build_ldata <- function(PARCELLE,
- METEO,
+build_ldata <- function(parcels,
+ meteo,
gdata = NULL,
- vector_species = "Ae. albopictus",
- climate = "temperate",
+ vector = "Ae. albopictus (D)",
+ virus = 'DEN',
mMov = NULL,
+ prev_control = NULL,
start_date = NULL,
end_date = NULL,
- nYR_init = 1){
-
+ nYR_init = 1) {
####################
### General data ###
####################
- # input data:
- # PARCELLE : table where each row is a node and columns are attributes
- # METEO: table with four columns nodeID, date, daily rainfall, daily mean temperature
- check_PARCELLE(PARCELLE)
+ # Check parcels
+ check_parcels(parcels)
- ## Inform user on number of PARCELLES, include possibility to use shape
- ## check PARCELLE columns
- # popID = "POP"
+ # Check meteo
+ if (!(is.data.frame(meteo) || is.data.table(meteo)))
+ stop("meteo must be a data.table or a data.frame")
- if(!(is.data.frame(METEO) | is.data.table(METEO)))
- stop("METEO must be a data.table or a data.frame")
+ meteo <- copy(meteo)
+ setDT(meteo)
- METEO <- copy(METEO)
- setDT(METEO)
+ required_meteo_cols <- c("ID", "DATE", "RR", "TP")
+ if (!all(required_meteo_cols %in% names(meteo)))
+ stop("meteo must contain at least the following columns: 'ID', 'DATE', 'RR', 'TP'")
- if(NA %in% match(c("ID", "DATE", "RR", "TP"), names(METEO)))
- stop("METEO must contain at least 4 columns: 'ÃŒD', 'DATE', 'RR', 'TP' ")
+ if (!inherits(meteo$ID, c("factor", "character")))
+ stop('meteo$ID must be a character vector')
############################
### Model initialization ###
############################
- if(is.null(start_date))
- start_date <- min(METEO$DATE) %>% as.Date
+ # Set default start and end dates
+ if (is.null(start_date))
+ start_date <- min(meteo$DATE) %>% as.Date
- if(is.null(end_date))
- end_date <- max(METEO$DATE) %>% as.Date
+ if (is.null(end_date))
+ end_date <- max(meteo$DATE) %>% as.Date
- if(start_date < min(METEO$DATE) | end_date > max(METEO$DATE))
- stop("start_date and end_date must be included in meteorological records")
+ if (!inherits(start_date, "Date"))
+ start_date <- as.Date(start_date)
- message(paste("Simulation period is from",start_date , "to",end_date))
+ if (!inherits(end_date, "Date"))
+ end_date <- as.Date(end_date)
- #### Simulation duration ####
+ if (start_date < min(meteo$DATE) || end_date > max(meteo$DATE))
+ stop("start_date and end_date must be within the range of meteorological records")
+
+ message(paste("Simulation will run for", ifelse('STATION' %in% names(parcels),
+ sum(parcels$STATION %in% meteo$ID), sum(parcels$ID %in% meteo$ID)),
+ "parcels from", start_date, "to", end_date))
+
+ # Create simulation time series
TS_sim <- sim_time_serie(start_date, end_date, nYR_init)
- ### Check if all meteorological data are available
- test_meteo <- expand.grid(ID = METEO$ID %>% unique, DATE = seq(from = start_date,
- to = end_date, by = "days"))
- test_meteo$ID %<>% as.numeric
- test_meteo$DATE %<>% as.Date
+ # Check if all meteorological data are available
+ test_meteo <- expand.grid(ID = unique(meteo$ID), DATE = seq(from = start_date, to = end_date, by = "days"))
+ test_meteo$DATE <- as.Date(test_meteo$DATE)
+ meteo$DATE <- as.Date(meteo$DATE)
- if(anti_join(test_meteo, METEO, by = c("ID", "DATE")) %>% nrow %>% is_greater_than(0))
- stop("daily meteorological records are missing for the period")
+ setDT(test_meteo)
+ setDT(meteo)
- rm(test_meteo)
+ if (nrow(test_meteo[!meteo, on = .(ID, DATE)]) > 0)
+ stop("Daily meteorological records are missing for the period")
###############################################################
- ## Define the compartments, gdata and stochastic transitions ##
+ ## Define compartments, gdata, and stochastic transitions ##
###############################################################
- ## Stochastic transitions are related to the epidemiological model and the life cycle of infected mosquitoes.
-
- #### Global data (general parameters) ####
- gdata <- check_gdata(gdata, vector_species, climate, verbose = F)
-
- ##############
- ## Diapause ##
- ##############
-
- # Calculates days for diapause over all the simulated period and build pts_fun
- gdata %<>% .[-which(names(gdata) %in% c("startFav","endFav"))] %>% unlist
+ # Validate global parameters
+ gdata <- check_gdata(gdata, vector, virus, verbose = FALSE)
+ # Prepare global data
+ gdata <- unlist(gdata)
mode(gdata) <- "numeric"
##################
## Define ldata ##
##################
- ## ldata is a vector of local data: daily temperature, kL and kP and number of non infected mosquitoes in each stage.
- ## the first item (index = 0) is the number of simulated days, it will be used to daily update v0 with ldata content.
- ## Now improve this and use time to index data in ldata (local data).
-
- if(is.null(mMov)){
- mMov <- diag(nrow(PARCELLE))
- rownames(mMov) <- PARCELLE[, ID]
- colnames(mMov) <- PARCELLE[, ID]
-
- mMov <- list(proba_ij = mMov,
- proba_ji = mMov)
- message("The current scenario do not consider any human mobility (mMov = NULL)")
- }
- ldata <- create_ldata(PARCELLE, METEO, gdata, mMov, TS_sim)
+ if (is.null(mMov)) {
+ mMov <- diag(nrow(parcels))
+ rownames(mMov) <- colnames(mMov) <- parcels$ID
+ diag(mMov) <- 1
- ldata
+ mMov <- list(
+ mi_mixedpop = parcels$POP,
+ proba_ij = mMov,
+ proba_ji = mMov
+ )
+
+ names(mMov$mi_mixedpop) <- parcels$ID
+
+ message("No human mobility considered (mMov = NULL)")
}
+
+ ldata <- create_ldata(
+ parcels = parcels,
+ meteo = meteo,
+ gdata = gdata,
+ mMov = mMov,
+ TS_sim = TS_sim,
+ prev_control = prev_control
+ )
+
+ return(ldata)
+}
diff --git a/R/build_mMov.R b/R/build_mMov.R
index 95c02b06f742196554678200917302a146bd4755..c9a19208995e28fba22eccaccb5773e5518147e8 100644
--- a/R/build_mMov.R
+++ b/R/build_mMov.R
@@ -1,134 +1,190 @@
-#' Creates a synthetic network
+#' Build matrix of contact probabilities
#'
-#' @description This function creates a synthetic human mobility network.
-#' You can use this script to generate different input data to be used as examples of "network structures".
+#' @description This function estimate probability matrices of movements/trips between all the polygons of a SpatVector or sf object and return them along with other mobility metrics.
#'
-#' @param PARCELLE data.table
-#' @param group string
-#' @param clust_ratio_inout numeric. Ratio of intra-building clustering (relative to inter-building clustering)
-#' @param within_clust_lev numeric. Probability of creating links between wards of the same building
-#' @param between_clust_lev numeric. Probability of creating links between wards of different building
-#' @param verbose logical. Print plot if TRUE
+#' @param SpatVec SpatVector or sf. Spatial vector of polygons representing patches. Polygons must include 'POP' and 'ID' attributes.
+#' @param law string. Law used to calculate probabilities. Default is "NGravExp". See documentation of `TDLM::run_law` function for law options details.
+#' @param param numeric. Parameter used to adjust the importance of distance or opportunity associated with the chosen law.
+#' A single value or a vector of several parameter values can be used.
+#' Not necessary for the original radiation law or the uniform law. (see TDLM package for more details)
+#' Default is NULL. If NULL but required the parameter will be estimated by TDLM package.
+#' @param p2move numeric. Optional. Daily probability to move from the residential patch or daily proportion of residents moving from the residential patch. p2move is required if outflow is not provided. If the outflow is provided, the p2move probability is not used.
+#' @param outflow numeric. Optional. Average number of person moving out of each patch daily.
+#' @param inflow numeric. Optional. Average number of person moving in each patch daily.
+#' @param verbose logical. Display more information during calculation
#'
-#' @importFrom igraph erdos.renyi.game
-#' @importFrom igraph as_adjacency_matrix
-#' @importFrom fields image.plot
-#' @import igraph
+#' @importFrom TDLM extract_spatial_information check_format_names run_law extract_opportunities calib_param run_model
+#' @importFrom sf st_as_sf
+#' @importFrom magrittr multiply_by
#'
-#' @usage build_mMov()
+#' @return List of mobility metrics:
#'
-#' @return a matrix with random probabilities of contact
-
-build_mMov_erdosrenyigame <- function(PARCELLE,
- group,
- within_clust_lev = 0.8,
- between_clust_lev = 0.1,
- clust_ratio_inout = 0.8,
- verbose = F){
-
- #######################################################################
-
- ## Checks
- if(clust_ratio_inout < 0 | clust_ratio_inout > 1) stop("\'clust_ratio_inout\' is a ratio and must be between 0 and 1")
-
- ## total number of patchs
- tot_n <- nrow(PARCELLE)
-
- ## matContact (contact matrix between wards)
- ## this is the matrix of the (proportion of) time spent by HCW in a given ward (row) in any other ward in the hospital (columns)
- ## sum of each row must be equal to 100 (i.e. 100%)
-
- ###############################################################################
- # Function that takes a graph as input and generates adjacency matrix as output
- ###############################################################################
-
- contact_matrix_generator <- function(g) {
- adj_M <- as_adjacency_matrix(g,sparse = F) %>% as.matrix()
- res <- apply(adj_M,1,function(x){
- if(sum(x) == 0) normalized_p = x else normalized_p = x/sum(x)
- normalized_p
- })
- return(res)
+#' `mi_mixedpop` is the estimated daily number of persons in each administrative unit (staying residents + visitors).
+#'
+#' `proba_ij` is a normalized matrix of probabilities for movements of residents from patch i (rows) in patch j in j (columns) (proba_ij). The referent population is the resident population.
+#'
+#' `proba_ji` is a normalized matrix of probabilities for origin i (columns) of agents in patch j (rows) (proba_ji). The referent population is the total population during the day including staying residents and visitors.
+#'
+#' @export
+
+build_mMov <- function(SpatVec,
+ law = "NGravExp",
+ param = NULL,
+ p2move = NULL,
+ outflow = NULL,
+ inflow = NULL,
+ verbose = F){
+
+ # CHECKS
+ message("Checks")
+
+ ## Check SpatVec format
+
+ if(!inherits(SpatVec, c("SpatVector", "sf")))
+ stop("SpatVec must be either a SpatVector or a sf object")
+
+ ### turn to sf is SpatVector
+ if(inherits(SpatVec, c("SpatVector"))){
+ if(verbose)
+ message("Turn to sf")
+ SpatVec %<>% st_as_sf
}
- # The idea in order to build the synthetic hospital ward network is to assume that hospital wards are clustered
- # (for example because they share the same building).
- # Wards within a building(=cluster) will be highly connected, while connection across buildings will be less frequent.
- # To implement this, we create a first layer with connection within buildings, a second layer with links across the buildings,
- # and we sum the two (with weights)
-
- ## the following function generates a matrix from the weighted sum of two networks
- generate_network <- function(PARCELLE,
- group,
- tot_n,
- p = c(within_clust_lev,between_clust_lev),
- dist_within_between = c(clust_ratio_inout,(1-clust_ratio_inout))){
-
-
- grouped <- PARCELLE %>% split(., by=group)
-
- # vector indicating the parameters of the erdos renyi graph for within building and at the hospital level networks
- # build a erdos.renyi.game network for each building
- networks_list <- lapply(grouped, function(group){
- clust_network <- erdos.renyi.game(nrow(group), p = p[1], type = "gnp")
- V(clust_network)$name <- group$ID
- clust_network
- })
-
- # build a erdos.renyi.game network for the whole hospital
- networks_full <- erdos.renyi.game(tot_n, p = p[2], type = "gnp")
- V(networks_full)$name <- PARCELLE$ID
-
- # create contact matrix
- M_full <- contact_matrix_generator(networks_full)
-
- M <- list()
- for(i in 1:length(networks_list)){
- M[[i]] <- contact_matrix_generator(networks_list[[i]])
- }
-
- # create a matrix of size n_wards*n_buidings with the blocks only
- M_cluster <- matrix(0, nrow=tot_n,ncol=tot_n)
- rownames(M_cluster) <- colnames(M_cluster) <- PARCELLE$ID
-
- for(i in length(networks_list)){
- range <- colnames(M[[i]])
- M_cluster[range,range] <- M[[i]]
- }
-
- # Generate final matrix as the sum of the two matrix
- # distribution of contacts that occur within cluster and outside cluster
-
- M_final = M_cluster*dist_within_between[1] + M_full*dist_within_between[2]
- # image(M_final)
-
- ## merge with a diagonal matrix so that final network has a strong diagonal component
- ## elements on the diagonal represent the time spent within its own word
- ## (which realistically should be higher than the time spent in any other ward; we assume at least 50% of the time)
- for(i in colnames(M_final)){
- ## time spent within their own patch
- t_patch <- runif(n = 1, min = 0.5, max = 0.8)
- M_final[i,] <- M_final[i,]*(1.- t_patch)
- M_final[i,i] <- M_final[i,i]+t_patch
- M_final[i,] <- M_final[i,]/sum(M_final[i,])
- }
-
- M_final %<>% t
-
- return(M_final)
+ ## Check SpatVec attributes
+
+ if(!("ID" %in% names(SpatVec)) | !("POP" %in% names(SpatVec)))
+ stop("SpatVec must include 'POP' and 'ID' as polygons attributes.")
+
+ ## Check param according to law
+
+ if(is.null(param) & law %in% c("GravExp", "GravPow"))
+ stop("For GravExp and GravPow laws, a parameter must be provided.")
+
+
+ ## Check inflow and outflow format
+
+ if(!is.null(outflow) & !is.null(p2move)){
+ warning("Only the outflow provided will be used. To use the p2move probability, set outflow at NULL")
}
- matContact = generate_network(PARCELLE,
- group,
- tot_n,
- p = c(within_clust_lev,between_clust_lev),
- dist_within_between = c(clust_ratio_inout,(1-clust_ratio_inout)))
+ if(is.null(outflow) & is.null(p2move))
+ stop("Either outflow or p2move should be provided.")
+
+ if(!is.null(outflow) & length(outflow) != nrow(SpatVec))
+ stop("For GravExp and GravPow laws, a parameter must be provided.")
+
+
+ if(is.null(p2move)){
+ p2move <- outflow / mi
+ p2move[is.na(p2move)] <- 0
+ }
if(verbose)
- image.plot(matContact)
+ message("Build mi, mj, Oi")
+
+ # Extract population
+ mass <- data.frame(Population = round(SpatVec$POP))
+ row.names(mass) <- SpatVec$ID
+
+ mi <- as.numeric(mass[,"Population"])
+ names(mi) <- rownames(mass)
+ mj <- mi
+
+ if(law %in% c("GravExp", "NGravExp","GravPow","NGravPow", "Schneider","RadExt", "Rad")){
+ if(verbose)
+ message("Compute distance between patches")
+ spi <- extract_spatial_information(SpatVec,
+ id = "ID",
+ show_progress = verbose)
+
+ distance <- spi$distance
+
+ check_format_names(vectors = list(mi = mi,
+ mj = mj),
+ matrices = list(distance = distance),
+ check = "format_and_names")
+
+
+ if(is.null(param) & law %in% c("NGravExp", "NGravPow", "Schneider","RadExt"))
+ param <- spi$surface %>% mean %>% calib_param(av_surf = ., law = law)
+
+ } else distance = NULL
+
+
+ if(law %in% c("Schneider", "Rad", "RadExt")){
+
+ if(verbose)
+ message("Compute opportunity vector")
+
+ sij <- extract_opportunities(
+ opportunity = mi,
+ distance = distance,
+ check_names = TRUE
+ )
+
+ } else sij = NULL
+
+ if(verbose)
+ message("Compute travelling distributions")
+ res <- run_law(
+ law = law,
+ mass_origin = mi,
+ mass_destination = mj,
+ distance = distance,
+ opportunity = sij,
+ param = param,
+ check_names = TRUE
+ )
+
+ if(verbose)
+ message("Normalize probabilities")
+
+ proba_ij <- res$proba
+ proba_ij <- proba_ij / apply(proba_ij,1,sum)
+ proba_ij[is.na(proba_ij)] <- 0
+ proba_ij %<>% multiply_by(p2move)
+ diag(proba_ij) <- 1 - p2move
+
+ ###### Estimate the daily total population and proportion of resident in each patch using Production constrained model
+
+ if(is.null(outflow))
+ outflow <- p2move * mi
+
+ if(is.null(inflow)){
+ simulated_trips <- run_model(
+ res$proba,
+ model = "PCM",
+ nb_trips = NULL,
+ out_trips = outflow,
+ average = T,
+ nbrep = 1,
+ maxiter = 50,
+ mindiff = 0.01,
+ check_names = FALSE
+ )
+ inflow <- colSums(simulated_trips$replication_1)
+ }
+
+ mi_mixedpop <- mi - outflow + inflow
+ pii <- (mi - outflow)/mi_mixedpop
+ pii[is.na(pii)] <- 0
+ names(mi_mixedpop) <- colnames(proba_ij)
+
+ proba_ji <- res$proba %>% t
+ proba_ji <- proba_ji / apply(proba_ji,1,sum)
+ proba_ji[is.na(proba_ji)] <- 0
+ proba_ji %<>% multiply_by(1-pii)
+ diag(proba_ji) <- pii
+
+ colnames(proba_ji) <-
+ colnames(proba_ij) <-
+ rownames(proba_ji) <-
+ rownames(proba_ij) <- row.names(mass)
- rownames(matContact) <- PARCELLE$ID
- colnames(matContact) <- PARCELLE$ID
+ mob_features <- list(
+ mi_mixedpop = mi_mixedpop,
+ proba_ij = proba_ij,
+ proba_ji = proba_ji)
- return(matContact)
+ return(mob_features)
}
diff --git a/R/build_mMov_TDLM_based.R b/R/build_mMov_TDLM_based.R
deleted file mode 100644
index cea9a8e480feece6acc0e5801565c48afb46767d..0000000000000000000000000000000000000000
--- a/R/build_mMov_TDLM_based.R
+++ /dev/null
@@ -1,107 +0,0 @@
-#' Build matrix of contact probabilities
-#'
-#' @description This function creates a synthetic human mobility network.
-#' You can use this script to generate different input data to be used as examples of "network structures".
-#'
-#' @param SpatVec SpatVector or sf. Spatial vector of polygons representing patches. Polygons must include 'POP' and 'ID' attributes.
-#' @param law string. Law used to calculate probabilities. Default is "Unif". See documentation of TDLM::run_law function for law options details.
-#' @param param numeric. Parameter used to adjust the importance of distance or opportunity associated with the chosen law.
-#' A single value or a vector of several parameter values can be used.
-#' Not necessary for the original radiation law or the uniform law. (see TDLM package for more details)
-#' @param p2move numeric. Probability to be in the residential patch.
-#' @param pCom numeric. Proportion of cummuters per patch
-#'
-#' @importFrom TDLM extract_spatial_information
-#' @importFrom TDLM check_format_names
-#' @importFrom TDLM run_law
-#' @importFrom TDLM extract_opportunities
-#'
-#' @usage build_mMov(SpatVec)
-#'
-#' @return list of normalized matrices for probabilities of contact of agent from patch i with agent of patch j in j (proba_ij) and probabilities of contact of agent from patch j with agent of patch i in i (proba_ji)
-#'
-#' @export
-
-build_mMov <- function(SpatVec,
- law = "Unif",
- param = NULL,
- p2move = 0.7,
- pCom = 0.7){
-
- message("Checks")
- if(!inherits(SpatVec, c("SpatVector", "sf")))
- stop("SpatVec must be eaither a SpatVector or a sf object")
-
- if(!("ID" %in% names(SpatVec)) | !("POP" %in% names(SpatVec)))
- stop("SpatVec must include 'POP' and 'ID' as polygons attributes.")
-
- ## turn to sf
- if(inherits(SpatVec, c("SpatVector"))){
- message("Turn to sf")
- SpatVec %<>% sf::st_as_sf(.)
- }
-
- message("Build mi, mj, Oi")
- mass <- data.frame(Population = round(SpatVec$POP),
- Outcommuters = round(pCom * SpatVec$POP))
-
- row.names(mass) <- SpatVec$ID
-
- mi <- as.numeric(mass[,1])
- names(mi) <- rownames(mass)
-
- mj <- mi
-
- Oi <- as.numeric(mass[,2])
- names(Oi) <- rownames(mass)
-
- message("Compute distance between patches")
- spi <- extract_spatial_information(SpatVec, id = "ID")
- distance <- spi$distance
-
- check_format_names(vectors = list(mi = mi, mj = mj, Oi = Oi),
- matrices = list(distance = distance),
- check = "format_and_names")
-
- message("Compute opportunity vector")
- opportunity <- mass[, 1]
- names(opportunity) <- rownames(mass)
-
- sij <- extract_opportunities(
- opportunity = opportunity,
- distance = distance,
- check_names = TRUE
- )
-
- message("Run model")
- res <- run_law(
- law = law,
- mass_origin = mi,
- mass_destination = mj,
- distance = distance,
- opportunity = sij,
- param = param,
- check_names = TRUE
- )
-
- message("Normalize probabilities")
- proba_ij <- res$proba
-
- for(i in proba_ij %>% nrow %>% seq){
- proba_ij[i,] <- (p2move * proba_ij[i,])/sum(proba_ij[i,])
- proba_ij[i,i] <- (1 - p2move)
- }
-
- proba_ji <- proba_ij
- colnames(proba_ji) <- colnames(proba_ij) <- rownames(proba_ji) <- rownames(proba_ij) <- row.names(mass)
-
- for(i in proba_ji %>% nrow %>% seq){
- proba_ji[,i] <- proba_ji[,i]/sum(proba_ji[,i])
- }
-
-
-
- proba <- list(proba_ij = proba_ij,
- proba_ji = proba_ji)
- return(proba)
-}
diff --git a/R/build_prev_control.R b/R/build_prev_control.R
new file mode 100644
index 0000000000000000000000000000000000000000..3c87c6e96c5ab5d71d99e1f4020f8be3c7743150
--- /dev/null
+++ b/R/build_prev_control.R
@@ -0,0 +1,108 @@
+#' Generate the list of preventive control to implement in the simulation
+#'
+#' @description Function used to generate the preventive control data.frame.
+#'
+#' Note that the distance unit of the buffer width parameter is meters if the CRS is (+proj=longlat), and in map units (typically also meters) if not.
+#'
+#' @param action string. 'K': Source reduction (removal or destruction of breeding sites); 'L': Chemical Larviciding; 'A': Fogging or Area Spraying (targets adult mosquitoes)
+#' @param lon string. longitude of the control location
+#' @param lat string. latitude of the control location
+#' @param start date in '\%Y-\%m-\%d' format. Define the beginning of the implemented measure
+#' @param end date in '\%Y-\%m-\%d' format. Define the end of the implemented measure
+#' @param p number between 0 and 1. It is for the "K" action: the proportion of sites daily removed during the action ; for the "A" action: the additional daily mortality of adults due to action and for the "L" action: the additional daily mortality of larvae due to larvicide
+#' @param SpatVec SpatVector or sf. (Required with buffer) Spatial vector of polygons representing patches. Polygons must include 'ID' attribute including the 'loc'.
+#' @param prev_control data.frame. (optional) prev_control object to build on (add new measures)
+#' @param buffer_width integer. (optional) Buffer around the location to implement the measure
+#' @param plot_buffer logical. Display plot of the selected parcels in case of spatial buffer.
+#'
+#' @return events data.frame with preventive control measures
+#'
+#' @importFrom terra relate buffer vect is.related crs
+#' @importFrom magrittr divide_by equals
+#' @importFrom data.table rbindlist
+#' @keywords events
+#'
+#' @examples
+#'
+#' f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+#' SpatVec <- terra::vect(f)
+#' build_prev_control(action = "K",
+#' lon = 1022397, lat = 6321347,
+#' start = "2022-01-01", end = "2022-01-05",
+#' p = 0.2,
+#' SpatVec = SpatVec,
+#' buffer_width = 100)
+#'
+#' @export
+
+build_prev_control <- function(action,
+ lon,
+ lat,
+ start,
+ end,
+ p,
+ SpatVec,
+ prev_control = NULL,
+ buffer_width = NULL,
+ plot_buffer = F){
+
+ if(is.null(prev_control))
+ prev_control <- data.table(
+ action = character(),
+ loc = factor(),
+ start = structure(numeric(0), class = "Date"),
+ end = structure(numeric(0), class = "Date"),
+ p = numeric()
+ )
+ # fix me check the column of prev_control
+
+ # CHECK: is the point into the study area
+ if(is.related(SpatVec, vect(data.frame(lon = lon, lat = lat),
+ geom=c("lon", "lat"),
+ crs=crs(SpatVec)), "intersects") %>% sum %>% equals(0))
+ stop("The point and buffer zone do not overlap with the study area.")
+
+ if(!is.null(buffer_width)){
+ buffer_ids <- relate(SpatVec,
+ buffer(vect(data.frame(lon = lon, lat = lat),
+ geom=c("lon", "lat"),
+ crs=crs(SpatVec)),
+ buffer_width),
+ "intersects", pairs=FALSE, na.rm=TRUE) %>% c %>% SpatVec[., ]
+ if(plot_buffer)
+ plot(buffer_ids)
+
+ # For each intersected parcel, calculate the proportion of covered area
+
+ p_covered_area <- sapply(seq(nrow(buffer_ids)), function(i)
+ crop(buffer_ids[i,],
+ buffer(vect(data.frame(lon = lon, lat = lat),
+ geom=c("lon", "lat"),
+ crs=crs(SpatVec)),
+ buffer_width),
+ ext=T) %>% expanse %>% divide_by(expanse(buffer_ids)[i]))
+
+ loc <- buffer_ids$ID
+
+ prev_control %<>% list(., data.table(
+ action = action,
+ loc = loc,
+ start = as.Date(start),
+ end = as.Date(end),
+ p = p * p_covered_area)) %>% rbindlist(fill = TRUE)%>% unique
+
+ } else
+ prev_control %<>% list(., data.table(
+ action = action,
+ loc = relate(SpatVec,
+ vect(data.frame(lon = lon, lat = lat),
+ geom=c("lon", "lat"),
+ crs=crs(SpatVec)),
+ "intersects", pairs=FALSE, na.rm=TRUE) %>% c %>% SpatVec[.,] %>% .$ID,
+ start = as.Date(start),
+ end = as.Date(end),
+ p = p)) %>% rbindlist(fill = TRUE)%>% unique
+
+ return(prev_control)
+
+}
diff --git a/R/build_pts_fun.R b/R/build_pts_fun.R
index 568370479d6fa535e539a93ef4d9f08b2fa98c5c..b3d29833af71d89e4723ba94d49b2258922780a5 100644
--- a/R/build_pts_fun.R
+++ b/R/build_pts_fun.R
@@ -4,31 +4,116 @@
#'
#' @usage build_pts_fun(u0, v0, gdata, ldata, diapause_interv)
#'
-#' @param u0 initial population stage for compartment driven by stochastic processes
+#' @param u0 data.frame describing the initial population stage for each compartment in each parcel. can be generated by [iniState()] function (see documentation of the function for more details on the structure).
#' @param v0 continuous variables. Contains post time step state of vector population as well as daily meteorological data.
#' @param gdata list of global data
#' @param ldata matrix of local data
+#' @param vector string vector species
#' @param diapause_interv interval of days defining favorable period for mosquitoes
+#' @param prev_control data.frame or data.table describing preventive control measure implemented. Required columns: 'action', 'loc', 'start', 'end', 'p' (see details)
+#'
+#' @details
+#' Preventive control content:
+#' 'action' column must be strings 'K', 'L' or 'A'. 'K': Source reduction (removal or destruction of breeding sites); 'L': Chemical Larviciding; 'A': Fogging or Area Spraying (targets adult mosquitoes)
+#' 'loc' column must be a parcel id
+#' 'start' is the first day of implementation of the measure
+#' 'end' is the last day of implementation of the measure (the control is implemented every day in between)
+#' 'p' must be a number between 0 and 1. It is for the "K" action: the proportion of sites daily removed during the action ; for the "A" action: the additional daily mortality of adults due to action and for the "L" action: the additional daily mortality of larvae due to larvicide
#'
#' @return String containing C code used as pts_fun by SimInf package
#'
+#' @importFrom data.table month mday `:=`
+#'
+#'
#' @keywords internal
#'
#' @noRd
-build_pts_fun <- function(u0, v0, gdata, ldata, diapause_interv){
+build_pts_fun <- function(u0,
+ v0,
+ gdata,
+ ldata,
+ vector,
+ virus,
+ diapause_interv,
+ TS_sim,
+ prev_control){
+
- diapause_string <- ""
+ if(!is.null(diapause_interv)){
+ diapause_string <- ""
- for(i in 0:(round(length(diapause_interv)/2)-1)){
+ for(i in 0:(round(length(diapause_interv)/2)-1)){
- if(is.na(diapause_interv[i*2+2]))
- diapause_string <- paste0(diapause_string, "(int)t >=",diapause_interv[i*2+1])
- else
- if(i < (round(length(diapause_interv)/2)-1))
- diapause_string <- paste0(diapause_string, paste("(int)t >=",diapause_interv[i*2+1]," && (int)t < ",diapause_interv[i*2+2]," || "))
- else
- diapause_string <- paste0(diapause_string, paste("(int)t >=",diapause_interv[i*2+1]," && (int)t < ",diapause_interv[i*2+2]))
+ if(is.na(diapause_interv[i*2+2]) || (i*2+2 > length(diapause_interv))){
+ diapause_string <- paste0(diapause_string, "(int)t >= ", diapause_interv[i*2+1])
+ } else {
+ if(i < (round(length(diapause_interv)/2)-1)){
+ diapause_string <- paste0(diapause_string, paste("((int)t >= ",diapause_interv[i*2+1]," && (int)t < ",diapause_interv[i*2+2],") || "))
+ } else {
+ diapause_string <- paste0(diapause_string, paste("((int)t >= ",diapause_interv[i*2+1]," && (int)t < ",diapause_interv[i*2+2],")"))
+ }
+ }
+ }
+
+ # Gestion du dernier intervalle si la longueur de diapause_interv est impaire
+ if(length(diapause_interv) %% 2 == 1){
+ diapause_string <- paste0(diapause_string, " || (int)t >= ", diapause_interv[length(diapause_interv)])
+ }
+ }
+
+ resetting_string <- ""
+ resetting_times <- which(data.table::month(TS_sim$time_serie_date) == 1 & data.table::mday(TS_sim$time_serie_date) == 1) - 1
+
+ for(i in resetting_times){
+ if(resetting_string == "")
+ resetting_string <- paste0(resetting_string, "(int)t ==",i - 1) else
+ resetting_string <- paste0(resetting_string, "|| (int)t ==",i - 1)
+ }
+
+ PL_interv <- NULL
+ PA_interv <- NULL
+ PK_interv <- NULL
+
+ if(!is.null(prev_control)){
+ prev_control[, `:=`(
+ start_time = match(start, TS_sim$time_serie_date) %>% TS_sim$time_serie_num[.],
+ end_time = match(end, TS_sim$time_serie_date) %>% TS_sim$time_serie_num[.],
+ id = seq(.N))]
+
+ for(interv in prev_control[action == "L", id]){
+ PL_interv %<>% paste(.,
+ paste0(c('if((int)t >= ',prev_control[id == interv, "start_time"],' && (int)t <= ',prev_control[id == interv, "end_time"],
+ '){if(fmL + ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,'] > 1){ fmL = 1; }else{fmL = fmL + ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,'];}
+ }
+ '), collapse =""),
+ collapse =" \n")
+ }
+
+ for(interv in prev_control[action == "A", id]){
+ PA_interv %<>% paste(.,
+ paste0(c('if((int)t >= ',prev_control[id == interv, "start_time"],' && (int)t <= ',prev_control[id == interv, "end_time"],
+ '){if(fmA + ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,'] > 1){fmA = 1 ;} else {fmA = fmA + ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,'];}
+ //v_new[', which(rownames(v0) == "test") - 1,'] = 1L;
+ interv_Adultm = interv_Adultm + ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,'];
+ }
+ '), collapse =""),
+ collapse =" \n")
+ }
+
+
+
+ for(interv in prev_control[action == "K", id]){
+ PK_interv %<>% paste(.,
+ paste0(c('if((int)t >= ',prev_control[id == interv, "start_time"],' && (int)t <= ',prev_control[id == interv, "end_time"],
+ '){
+ kP = kP * (1 - ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,']);
+ kL = kL * (1 - ldata[', which(rownames(ldata) == paste0("CSS_",interv)) - 1,']);
+ //v_new[', which(rownames(v0) == "test") - 1,'] = 1L;
+ }
+ '), collapse =""),
+ collapse =" \n")
+ }
}
###########################################################
@@ -40,6 +125,7 @@ build_pts_fun <- function(u0, v0, gdata, ldata, diapause_interv){
//// Declare variables
+const int nNodes = (int)',nrow(u0), 'L;
const int nCpmt_u = (int)',ncol(u0), 'L;
const int nCpmt_v = (int)',nrow(v0), 'L;
const int * u_0 = &u[-node * nCpmt_u];
@@ -48,11 +134,10 @@ const double * v_0 = &v[-node * nCpmt_v];
//// Population Dynamics
// update diapause
- v_new[', which(rownames(v0) == "z") - 1,'] = 0;
+ ', if(!is.null(diapause_interv)) paste0('v_new[', which(rownames(v0) == "z") - 1,'] = 0;
if(',diapause_string,')
- v_new[', which(rownames(v0) == "z") - 1,'] = 1;
-
-
+ v_new[', which(rownames(v0) == "z") - 1,'] = 1;'),
+ '
// update temperature and carrying capacities
double temperature;
long kP;
@@ -62,7 +147,27 @@ const double * v_0 = &v[-node * nCpmt_v];
temperature = ldata[', which(rownames(ldata) == "Tp_1") - 1,' + (int)t];
v_new[', which(rownames(v0) == "temperature") - 1,'] = temperature;
- fk = ldata[', which(rownames(ldata) == "kvar") - 1,'] * ldata[', which(rownames(ldata) == "RR7_1") - 1,' + (int)t];
+
+ // Update rain
+ v_new[', which(rownames(v0) == "RR_day") - 1,'] = ldata[', which(rownames(ldata) == "RR_1") - 1,' + (int)t];
+ double RR_day;
+ RR_day = v_new[', which(rownames(v0) == "RR_day") - 1,'];
+
+
+ double RR_7days;
+ RR_7days = 0;
+ int rainyD;
+ for(rainyD = 0; rainyD <= 6; ++rainyD){
+ if(((int)t - rainyD) >= 0)
+ RR_7days = RR_7days + ldata[', which(rownames(ldata) == "RR_1") - 1,' + (int)t - rainyD];
+ }
+
+ v_new[', which(rownames(v0) == "RR_7days") - 1,'] = RR_7days;
+
+ fk = ldata[', which(rownames(ldata) == "kvar") - 1,'] * (RR_7days / 150);
+
+ // 150 replace : ldata[(rownames(ldata) %>% startsWith(., "RR") %>% which %>% min) : (rownames(ldata) %>% startsWith(., "RR") %>% which %>% max),] %>% max
+
if(fk < ldata[', which(rownames(ldata) == "kvar") - 1,']){
kP = ldata[', which(rownames(ldata) == "kfix") - 1,'] + fk;
kL = ldata[', which(rownames(ldata) == "kfix") - 1,'] + fk;
@@ -71,9 +176,33 @@ const double * v_0 = &v[-node * nCpmt_v];
kL = ldata[', which(rownames(ldata) == "kfix") - 1,'] + ldata[', which(rownames(ldata) == "kvar") - 1,'];
}
+ //v_new[', which(rownames(v0) == "test") - 1,'] = 0;
+
+ // if Preventive reduction of environmental carrying capacities (PK) multiply kP and kL by prev_control$p and ldata CSS
+',if(!is.null(PK_interv)) PK_interv,'
+
+
+ if(kP < 1) kP = 1;
+ if(kL < 1) kL = 1;
+
v_new[', which(rownames(v0) == "kP") - 1,'] = kP;
v_new[', which(rownames(v0) == "kL") - 1,'] = kL;
+ v_new[', which(rownames(v0) == "E2I") - 1,'] = ',
+ if(virus == "DEN")
+ '0.11 * pow(temperature,2) - 7.13 * temperature + 121.17;' else ## equation from arbocarto
+ # '4 + exp(5.15-0.123*temperature);' else ## equation from AedesRisk
+ # faedesrisk <- rlang::as_function(~ 4 + exp(5.15-0.123*.x))
+ # farbocarto <- rlang::as_function(~ 0.11 * .x^2 - 7.13 * .x + 121.17)
+ # ggplot(data.frame(x = -3:37), aes(x)) +
+ # geom_function(fun = faedesrisk, colour = "red")+
+ # geom_function(fun = farbocarto, colour = "blue")
+ if(virus == "CHI")
+ '4 + exp(5.15-0.123*temperature);' else
+ if(virus == "ZIK") # https://journals.plos.org/plosntds/article?id=10.1371/journal.pntd.0008047
+ '1/(7-(-0.667 + 0.378*(temperature-26))/(0.299+0.027*(temperature-26)));'
+ ,'
+
// Development and mortality functions
// EGGS
@@ -85,35 +214,57 @@ const double * v_0 = &v[-node * nCpmt_v];
int neweggS;
neweggS =', gdata["gammaAo"], ' * (v[', which(rownames(v0) == "A1om") - 1,'] * ', gdata["beta1"], ' + v[', which(rownames(v0) == "A2om") - 1,'] * ', gdata["beta2"], ');
+ v_new[', which(rownames(v0) == "newEggs") - 1,'] = neweggS + neweggI;
// eggs development into larvae and mortality
double fdevE;
- if(temperature > ', gdata["TE"], '){
- fdevE = v_new[', which(rownames(v0) == "z") - 1,'] * ((temperature - ', gdata["TE"], ') / ', gdata["TDDE"], ');
+ if(',feggs(vector, gdata),' > 0){
+ fdevE = v_new[', which(rownames(v0) == "z") - 1,'] * ',feggs(vector, gdata),';
}else{
fdevE = 0;
}
+ double fmuE;
+ fmuE = ', gdata["muE"],';
+ if(RR_day > 80){
+ fmuE = fmuE + ', gdata["muErain"],';
+ }
+
long varEm;
if((', gdata["muE"],' + fdevE) > 1){
varEm = neweggI + neweggS - v[', which(rownames(v0) == "Em") - 1,'];
} else{
- varEm = neweggI + neweggS - v[', which(rownames(v0) == "Em") - 1,'] * (', gdata["muE"],' + fdevE);
+ varEm = neweggI + neweggS - v[', which(rownames(v0) == "Em") - 1,'] * (fmuE + fdevE);
}
// LARVAE
// larvae development into pupae
double fdevL;
- if((', gdata["q1L"], ' * temperature * temperature + ', gdata["q2L"], ' * temperature + ', gdata["q3L"], ') < 0){
+ if(',flarvae(vector, gdata),' < 0){
fdevL = 0;
} else {
- fdevL = (', gdata["q1L"], ' * temperature * temperature + ', gdata["q2L"], ' * temperature + ', gdata["q3L"], ');
+ fdevL = ',flarvae(vector, gdata),';
}
// larvae mortality
double fmL;
+ if(kL > 0){
fmL = (', gdata["mu1L"], ' * exp((temperature-10)*', gdata["mu2L"], ') + ', gdata["mu3L"], ') * (1 + v[', which(rownames(v0) == "Lm") - 1,']/kL);
+ } else {
+ fmL = 1;
+ }
+
+ if(RR_day > 80){
+ fmL = fmL + ', gdata["muLrain"],';
+ }
+
+
+ // if Preventive Larvicide (PL) in prev_control and time between ... (select the right rows) multiply fmL by prev_control$p and ldata CSS
+',if(!is.null(PL_interv)) PL_interv,'
+
+
+ if(fmL > 1) fmL = 1;
long varLm;
if((fdevL + fmL) > 1){
@@ -126,13 +277,17 @@ const double * v_0 = &v[-node * nCpmt_v];
// pupae development into emerging adult
double fdevP;
- fdevP = (', gdata["q1P"], ' * temperature * temperature + ', gdata["q2P"], ' * temperature + ', gdata["q3P"], ');
+ fdevP = ', fpupae(vector, gdata),';
if(fdevP < 0)
fdevP = 0;
// pupae mortality
double fmP;
- fmP = (', gdata["mu1P"], ' * exp((temperature-10)*', gdata["mu2P"], ') + ', gdata["mu3P"], ') * (1 + v[', which(rownames(v0) == "Pm") - 1,']/kP);
+ fmP = (', gdata["mu1P"], ' * exp((temperature-10)*', gdata["mu2P"], ') + ', gdata["mu3P"], ');
+
+ if(RR_day > 80){
+ fmP = fmP + ', gdata["muLrain"],';
+ }
long varPm;
if((fdevP + fmP) > 1){
@@ -149,9 +304,24 @@ const double * v_0 = &v[-node * nCpmt_v];
if(fmA < ', gdata["mu3A"], ')
fmA = ', gdata["mu3A"], ';
- // emerging aldult mortality
- double fmAEm;
- fmAEm = exp(-', gdata["muEM"], ' * (1+v[', which(rownames(v0) == "Pm") - 1,']/kP));
+ // emerging aldult survival
+ double fsAEm;
+ if(kP > 0){
+ fsAEm = exp(-', gdata["muEM"], ' * (1 + v[', which(rownames(v0) == "Pm") - 1,']/kP));
+ } else {
+ fsAEm = 0;
+ }
+
+ // if Preventive Adulticide (PA) in prev_control and time between ... (select the right rows) multiply fmL by prev_control$p and ldata CSS
+
+ double interv_Adultm;
+ interv_Adultm = 0;
+
+',if(!is.null(PA_interv)) PA_interv,'
+
+ v_new[', which(rownames(v0) == "interv_Am") - 1,'] = interv_Adultm;
+
+ if(fmA > 1) fmA = 1;
// aldult mortality in research activity
double fmAr;
@@ -159,14 +329,16 @@ const double * v_0 = &v[-node * nCpmt_v];
// aldult gorging activity
double fAg;
- if(temperature > ', gdata["TAG"], '){
- fAg = (temperature - ', gdata["TAG"], ')/', gdata["TDDAG"], ';
+ if(',fadult(vector, gdata),' > 0){
+ fAg = ',fadult(vector, gdata),';
} else {
fAg = 0;
}
+ v_new[', which(rownames(v0) == "G2O") - 1,'] = fAg;
+
double varAemm;
- varAemm = v[', which(rownames(v0) == "Pm") - 1,'] * fdevP * ', gdata["sigma"],' * fmAEm - v[', which(rownames(v0) == "Aemm") - 1,'] * (fmA + ', gdata["gammaAem"], ') ;
+ varAemm = v[', which(rownames(v0) == "Pm") - 1,'] * fdevP * ', gdata["sigma"],' * fsAEm - v[', which(rownames(v0) == "Aemm") - 1,'] * (fmA + ', gdata["gammaAem"], ') ;
double varA1hm;
double infA1h;
@@ -176,7 +348,7 @@ const double * v_0 = &v[-node * nCpmt_v];
varA1hm = v[', which(rownames(v0) == "Aemm") - 1,'] * ', gdata["gammaAem"], ' - (v[', which(rownames(v0) == "A1hm") - 1,'] - infA1h) * (fmAr + ', gdata["gammaAh"], ') - infA1h ;
double varA1gm;
- varA1gm = v[', which(rownames(v0) == "A1hm") - 1,'] * ', gdata["gammaAh"], ' - v[', which(rownames(v0) == "A1gm") - 1,'] * (fmA + fAg) ;
+ varA1gm = v[', which(rownames(v0) == "A1hm") - 1,'] * ', gdata["gammaAh"], ' - v[', which(rownames(v0) == "A1gm") - 1,'] * (fmA + fAg) ;
double varA1om;
varA1om = v[', which(rownames(v0) == "A1gm") - 1,'] * fAg - v[', which(rownames(v0) == "A1om") - 1,'] * (fmAr + ', gdata["gammaAo"], ') ;
@@ -214,138 +386,223 @@ const double * v_0 = &v[-node * nCpmt_v];
// parous gorged adult
v_new[', which(rownames(v0) == "A2gm") - 1,'] = v[', which(rownames(v0) == "A2gm") - 1,'] + round(varA2gm) ;
// parous oviposition-site-seeking adult
- v_new[', which(rownames(v0) == "A2om") - 1,'] = v[', which(rownames(v0) == "A2om") - 1,'] + round(varA2om);
-
- //// Calcul of R0
-
- int atot;
- atot = u[',which(colnames(u0) == "A1gmI") - 1,
- '] + u[',which(colnames(u0) == "A1omI") - 1,
- '] + u[',which(colnames(u0) == "A2hmI") - 1,
- '] + u[',which(colnames(u0) == "A2gmI") - 1,
- '] + u[',which(colnames(u0) == "A2omI") - 1,
- ']+ v[', which(rownames(v0) == "Aemm") - 1,
- ']+ v[', which(rownames(v0) == "A1hm") - 1,
- ']+ v[', which(rownames(v0) == "A1gm") - 1,
- ']+ v[', which(rownames(v0) == "A1om") - 1,
- ']+ v[', which(rownames(v0) == "A2hm") - 1,
- ']+ v[', which(rownames(v0) == "A2gm") - 1,
- ']+ v[', which(rownames(v0) == "A2om") - 1,'];
-
- double taux_survie;
- taux_survie = 1 - ((v[', which(rownames(v0) == "Aemm") - 1,'] + v[', which(rownames(v0) == "A1hm") - 1,'] + v[', which(rownames(v0) == "A1gm") - 1,'] + v[', which(rownames(v0) == "A1om") - 1,'] + v[', which(rownames(v0) == "A2gm") - 1,'])/atot) * fmA - ((v[', which(rownames(v0) == "A2hm") - 1,']+v[', which(rownames(v0) == "A2om") - 1,'])/atot) * fmAr;
-
- double incub_extr;
- incub_extr = 0.11*(temperature*temperature)-7.13*temperature+121.17;
-
- double comp_vect;
- if(((-0.0043)*(temperature*temperature)+(0.2593*temperature)-3.2705) > 0){
- comp_vect = ((-0.0043)*(temperature*temperature)+(0.2593*temperature)-3.2705);
- } else {
- comp_vect = 0;
- }
+ v_new[', which(rownames(v0) == "A2om") - 1,'] = v[', which(rownames(v0) == "A2om") - 1,'] + round(varA2om) ;
- // Total human population
- int TP;
- TP = u[',which(colnames(u0) == "Sh") - 1,'] + u[',which(colnames(u0) == "Eh") - 1,'] + u[',which(colnames(u0) == "Ih") - 1,'] + u[',which(colnames(u0) == "Rh") - 1,'];
+ // reset mosquitoes pop (except eggs) during winter
+',if(!is.null(diapause_interv)) paste('
+ if(',resetting_string,'){
+ // larvae
+ v_new[', which(rownames(v0) == "Lm") - 1,'] = 0 ;
+ // pupae
+ v_new[', which(rownames(v0) == "Pm") - 1,'] = 0 ;
+ // emerging adult
+ v_new[', which(rownames(v0) == "Aemm") - 1,'] = 0 ;
+ // nulliparous host-seeking adult
+ v_new[', which(rownames(v0) == "A1hm") - 1,'] = 0 ;
+ // nulliparous gorged adult
+ v_new[', which(rownames(v0) == "A1gm") - 1,'] = 0 ;
+ // nulliparous oviposition-site-seeking adult
+ v_new[', which(rownames(v0) == "A1om") - 1,'] = 0 ;
+ // parous host-seeking adult
+ v_new[', which(rownames(v0) == "A2hm") - 1,'] = 0 ;
+ // parous gorged adult
+ v_new[', which(rownames(v0) == "A2gm") - 1,'] = 0 ;
+ // parous oviposition-site-seeking adult
+ v_new[', which(rownames(v0) == "A2om") - 1,'] = 0 ;
+ }'),'
- // Infected human population
- int IP;
- IP = u[',which(colnames(u0) == "Ih") - 1,'];
- double capac_vect;
- if(TP > 0 && atot > 0){
- capac_vect = atot/TP*pow((v[8] + v[11])*', gdata["gammaAh"], '/atot,2)*pow(taux_survie,incub_extr)/-log(taux_survie);
- } else {
- capac_vect = 0;
- }
+//// Calcul of R0
- int R0;
- if(R0 > TP){
- v_new[', which(rownames(v0) == "R0") - 1,'] = TP;
- } else {
- v_new[', which(rownames(v0) == "R0") - 1,'] = (comp_vect*capac_vect)/', gdata["rhoH"],';
- }
+double R0;
- //// Include mobility for infections
+// vectorial capacity
+double VectCap;
- //// pIm infection of host by mosquitoes from another patch
+// Vector competence
+double VectComp;
- // proportion of infected mosquitoes weighted by the probability of being in contact (probability to be in the patch)
- // initialize proportion
- double wIm;
- wIm = 0;
+// FIX ME adapt to ZIK CHI viruses
+if(((-0.0043)*pow(temperature,2)+(0.2593*temperature)-3.2705) > 0){
+ VectComp = ((-0.0043)*pow(temperature,2)+(0.2593*temperature)-3.2705);
+} else {
+ VectComp = 0;
+}
- // total number of mosquitoes looking for host in patch j
- int nMh;
+// vector density per host
+double VectDens;
+
+// Local number of adult mosquitoes
+int Am_tot_loc;
+Am_tot_loc = u[',which(colnames(u0) == "A1gmE") - 1,
+'] + u[',which(colnames(u0) == "A1omE") - 1,
+'] + u[',which(colnames(u0) == "A2hmE") - 1,
+'] + u[',which(colnames(u0) == "A2gmE") - 1,
+'] + u[',which(colnames(u0) == "A2omE") - 1,
+'] + u[',which(colnames(u0) == "A1gmI") - 1,
+'] + u[',which(colnames(u0) == "A1omI") - 1,
+'] + u[',which(colnames(u0) == "A2hmI") - 1,
+'] + u[',which(colnames(u0) == "A2gmI") - 1,
+'] + u[',which(colnames(u0) == "A2omI") - 1,
+']+ v[', which(rownames(v0) == "Aemm") - 1,
+']+ v[', which(rownames(v0) == "A1hm") - 1,
+']+ v[', which(rownames(v0) == "A1gm") - 1,
+']+ v[', which(rownames(v0) == "A1om") - 1,
+']+ v[', which(rownames(v0) == "A2hm") - 1,
+']+ v[', which(rownames(v0) == "A2gm") - 1,
+']+ v[', which(rownames(v0) == "A2om") - 1,'];
+
+// Local number of host
+int H;
+// FIX ME different from arbocarto
+// H = u[',which(colnames(u0) == "Sh") - 1,'] + u[',which(colnames(u0) == "Eh") - 1,'] + u[',which(colnames(u0) == "Ih") - 1,'] + u[',which(colnames(u0) == "Rh") - 1,'];
+H = ldata[', which(rownames(ldata) == "mi_mixedpop") - 1,'];
+
+if(H > 0 && Am_tot_loc > 0){
+ if(H > 0){
+ VectDens = Am_tot_loc/H;
+ } else {
+ VectDens = 0;
+ }
- // proportion of infected mosquitoes looking for host in patch j
- double pIMh;
- int j;
- // in each node
- for(j = 0; j <= node; ++j){
+ // daily bitting rate
+ double bittingR;
+
+ bittingR = (u[',which(colnames(u0) == "A2hmE") - 1,
+'] + u[',which(colnames(u0) == "A2hmI") - 1,
+'] + v[', which(rownames(v0) == "A1hm") - 1,
+'] + v[', which(rownames(v0) == "A2hm") - 1,'])/Am_tot_loc *', gdata["gammaAh"], ' ;
+
+ // daily survival rate
+ double survival_rate;
+ survival_rate = 1 - fmA * ((u[',which(colnames(u0) == "A1gmE") - 1,
+'] + u[',which(colnames(u0) == "A2gmE") - 1,
+'] + u[',which(colnames(u0) == "A1gmI") - 1,
+'] + u[',which(colnames(u0) == "A2gmI") - 1,
+']+ v[', which(rownames(v0) == "Aemm") - 1,
+']+ v[', which(rownames(v0) == "A1gm") - 1,
+']+ v[', which(rownames(v0) == "A2gm") - 1,']) / Am_tot_loc) - ((u[',
+which(colnames(u0) == "A1omE") - 1,
+'] + u[',which(colnames(u0) == "A2hmE") - 1,
+'] + u[',which(colnames(u0) == "A2omE") - 1,
+'] + u[',which(colnames(u0) == "A1omI") - 1,
+'] + u[',which(colnames(u0) == "A2hmI") - 1,
+'] + u[',which(colnames(u0) == "A2omI") - 1,
+'] + v[', which(rownames(v0) == "A1hm") - 1,
+'] + v[', which(rownames(v0) == "A1om") - 1,
+'] + v[', which(rownames(v0) == "A2hm") - 1,
+'] + v[', which(rownames(v0) == "A2om") - 1,'])/Am_tot_loc) * fmAr;
+
+ // extrinsic incubation period
+ double EIP;
+ //EIP = 0.11 * pow(temperature,2) - 7.13 * temperature + 121.17;
+ EIP = v_new[', which(rownames(v0) == "E2I") - 1,'];
+
+ VectCap = (VectDens * pow(bittingR, 2) * pow(survival_rate, EIP))/-log(survival_rate);
+
+ R0 = VectCap / ', gdata["rhoH"],' * VectComp;
+
+ if(R0 > u[',which(colnames(u0) == "Sh") - 1,']){
+ v_new[', which(rownames(v0) == "R0") - 1,'] = u[',which(colnames(u0) == "Sh") - 1,'];
+ } else {
+ v_new[', which(rownames(v0) == "R0") - 1,'] = R0;
+ }
- // total number of mosquitoes seeking host
- nMh = u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0),'] + v_0[', which(rownames(v0) == "A1hm") - 1,' + j * ',nrow(v0),'] + v_0[', which(rownames(v0) == "A2hm") - 1,' + j * ',nrow(v0),'];
+} else { // if no human or no mosquitoes
+ v_new[', which(rownames(v0) == "R0") - 1,'] = 0;
+}
- // proportion of infected mosquitoes seeking host
- if(nMh > 0){
- pIMh = (double) u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0),'] / nMh;
- } else {
- pIMh = 0;
- }
+//// Include mobility for infections
- // weight pIMh by the probability to be in j for individual from i
- pIMh = pIMh * ldata[',rownames(ldata) %>% startsWith(., "Oij_") %>% which %>% min %>% subtract(1),' + j];
- wIm = wIm + pIMh;
- }
+//// betaMext: infection of host by mosquitoes from another patch (probability to be infected externaly)
+
+// proportion of infected mosquitoes weighted by the probability of being in contact (probability to be in the patch)
+// initialize proportion
+double wImp;
+wImp = 0;
+
+// proportion of infected mosquitoes looking for host in patch j
+double hmIp;
+
+
+// biting rate in patch j
+double biter;
+
+// biting rate in patch j
+double Ahtot;
+
+// in each node
+int j;
+for(j = 0; j <= (nNodes - 1); ++j){
+
+ Ahtot = v_0[',which(rownames(v0) == "A1hm") - 1,' + j * ',nrow(v0),
+ '] + v_0[',which(rownames(v0) == "A2hm") - 1,' + j * ',nrow(v0),
+ '] + u_0[',which(colnames(u0) == "A2hmE") - 1,' + j * ',ncol(u0),
+ '] + u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0),'];
+
+ if(Ahtot > 0 && ldata[', which(rownames(ldata) == "mi_mixedpop") - 1,' + j] > 0){
+
+ //number of bite per host
+ biter = (double) (', gdata["gammaAh"],' * Ahtot) / ldata[', which(rownames(ldata) == "mi_mixedpop") - 1,' + j];
+ //biter = atan(biter) * ', gdata["maxbite"],'/(M_PI/2):
+
+ // weight pIMh by the probability to be in j for individual from
+ hmIp = (double) atan(biter) * ', gdata["maxbite"],'/(M_PI/2) * (u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0), '] / Ahtot) * ldata[',rownames(ldata) %>% startsWith(., "Oij_") %>% which %>% min %>% subtract(1),' + j];
+
+ //hmIp = (double) biter * (u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0), '] / Ahtot) * ldata[',rownames(ldata) %>% startsWith(., "Oij_") %>% which %>% min %>% subtract(1),' + j];
+ //hmIp = (double) (atan(gammaAh * u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0), '] * (1 / ldata[', which(rownames(ldata) == "mi_mixedpop") - 1,' + j])) * maxbite) / (M_PI/2) * ldata[',rownames(ldata) %>% startsWith(., "Oij_") %>% which %>% min %>% subtract(1),' + j];
+ //hmIp = (double) u_0[',which(colnames(u0) == "A2hmI") - 1,' + j * ',ncol(u0), '] * ldata[',rownames(ldata) %>% startsWith(., "Oij_") %>% which %>% min %>% subtract(1),' + j] * (1 / ldata[', which(rownames(ldata) == "mi_mixedpop") - 1,' + j]);
+
+ // add this probability to beta
+ wImp = wImp + hmIp;
- // exclude mosquitoes from patch i
- nMh = u[',which(colnames(u0) == "A2hmI") - 1,'] + v[', which(rownames(v0) == "A1hm") - 1,'] + v[', which(rownames(v0) == "A2hm") - 1,'];
- if(nMh > 0){
- wIm = wIm - ldata[', which(rownames(ldata) == "pOii") - 1,'] * (u[',which(colnames(u0) == "A2hmI") - 1,'] / nMh);
- } else {
- wIm = wIm ;
}
+}
- v_new[', which(rownames(v0) == "pIm") - 1,'] = (double) wIm;
+v_new[', which(rownames(v0) == "betaMext") - 1,'] = (double) wImp;
- //// pIh infection of mosquitoes by humans from another patch
- // proportion of infected humans weighted by the probability of being in contact (probability to be in the patch)
- // initialize proportion
- double wIh;
- wIh = 0;
+//// betaHext: infection of mosquitoes by humans from another patch (probability to be infected externaly)
- // total number of mosquitoes looking for host in the patch
- int nHtot;
- // proportion of infected mosquitoes looking for host in the patch
- double pIH;
+// proportion of infected humans weighted by the probability of being in contact (probability to be in the patch)
+double wIhp;
+// initialize proportion
+wIhp = 0.00;
- int k;
- // in each node
- for(k = 0; k <= node; ++k){
+// total number of host
+int htot;
- // total number of host
- nHtot = u_0[',which(colnames(u0) == "Sh") - 1,' + k * ',ncol(u0),
- '] + u_0[',which(colnames(u0) == "Eh") - 1,' + k * ',ncol(u0),
- '] + u_0[',which(colnames(u0) == "Ih") - 1,' + k * ',ncol(u0),
- '] + u_0[',which(colnames(u0) == "Rh") - 1,' + k * ',ncol(u0),'];
+// proportion of infected mosquitoes looking for host in the patch
+double Ip;
- // prportion of infected host
- if(nHtot > 0){
- pIH = (double) u_0[',which(colnames(u0) == "Ih") - 1,' + k * ',ncol(u0),'] / nHtot;
- } else {
- pIH = (double) 0;
- }
+int k;
+// in each node
+for(k = 0; k <= (nNodes - 1); ++k){
- pIH = pIH * ldata[',rownames(ldata) %>% startsWith(., "Dij_") %>% which %>% min %>% subtract(1),' + k];
- wIh = wIh + pIH;
+ // total number of host in patch k
+ htot = u_0[',which(colnames(u0) == "Sh") - 1,' + k * ',ncol(u0),
+'] + u_0[',which(colnames(u0) == "Eh") - 1,' + k * ',ncol(u0),
+'] + u_0[',which(colnames(u0) == "Ih") - 1,' + k * ',ncol(u0),
+'] + u_0[',which(colnames(u0) == "Rh") - 1,' + k * ',ncol(u0),'];
+
+ // proportion of infected host in patch k
+ if(htot > 0){
+ Ip = (double) u_0[',which(colnames(u0) == "Ih") - 1,' + k * ',ncol(u0),'] / htot;
+ } else {
+ Ip = (double) 0;
}
- v_new[', which(rownames(v0) == "pIh") - 1,'] = (double) wIh;
+ // weight pIMh by the probability to be in j for individual from
+ Ip = Ip * ldata[',rownames(ldata) %>% startsWith(., "Dij_") %>% which %>% min %>% subtract(1),' + k];
+
+ // add this probability to beta
+ wIhp = wIhp + Ip;
+}
+
+v_new[', which(rownames(v0) == "betaHext") - 1,'] = (double) wIhp;
+
return 1;
')
diff --git a/R/build_transitions.R b/R/build_transitions.R
index 6a1d1a73fc276479ba2ae74f39ee064b38e8e55b..b5b890346b8bdec28ff30f1ade7975b95c04e615 100644
--- a/R/build_transitions.R
+++ b/R/build_transitions.R
@@ -9,11 +9,9 @@
#' @return String vector describing transitions
#'
#' @keywords internal
-#' @noRd
#'
#' @export
-
build_transitions <- function(gdata){
#### Stochastic transitions ####
@@ -38,34 +36,89 @@ stoch_transitions <- c(
#### HUMANS INFECTION ####
## ninfh count the number of autochtonous transitions
- # Infection of host in the patch
- "A2hmI + Sh -> A2hmI * gammaAh * bMH * Sh/(Sh+Eh+Ih+Rh) * pOii -> A2gmI + Eh + ninfh",
- # Infection of host in another patch
- "Sh -> Sh * gammaAh * bMH * pIm -> Eh + ninfh",
+ ### blood meal of infected mosquitoes in the patch
+
+ # FIX ME adjust biting rate with arctan (a = arctan((gammaAh * Ah)/mi_mixedpop) * nmaxbite/(pi/2)
+
+ # 1/ feed on susceptible resident human and infect him
+ "A2hmI + Sh -> mi_mixedpop > 0 ? A2hmI * gammaAh * bMH * ((pii * Sh)/mi_mixedpop) * atan((gammaAh * (A1hm + A2hm + A2hmE + A2hmI))/mi_mixedpop) * maxbite/(M_PI/2) : 0 -> A2gmI + Eh + ninfhL",
+
+ # 2/ feed on human not resulting in a recorded infection
+ "A2hmI -> mi_mixedpop > 0 ? A2hmI * gammaAh : 0 -> A2gmI",
+ # "A2hmI -> mi_mixedpop > 0 ? A2hmI * gammaAh * (1 - ((1/mi_mixedpop) * pii * Sh * bMH)) : 0 -> A2gmI",
+
- # Infected mosquito is gorged without infecting anyone
- "A2hmI -> A2hmI * gammaAh * (1 - bMH * (Sh/(Sh+Eh+Ih+Rh) * pOii + (1 - pOii))) -> A2gmI",
+ ### Resident bitten in another patch
+ # 3/ Infection of a resident human in an other patch
+ "Sh -> mi_mixedpop > 0 ? betaMext * gammaAh * Sh * (1 - p2stay) * bMH * atan((gammaAh * (A1hm + A2hm + A2hmE + A2hmI))/mi_mixedpop) * maxbite/(M_PI/2) : 0 -> Eh + ninfhE",
+
+ ### Epidemiological stages
+
+ # 4/ Exposition (incubating)
"Eh -> Eh * muH -> Ih",
+
+ # 5/ Infectious period
"Ih -> Ih * rhoH -> Rh",
#### MOSQUITOS INFECTION ####
- # We do not consider "exposed" stage and temperature-dependent extrinsic incubation period (EIP) -- all females directly become infectious // we do not include recovery
- "@ -> (A1hm - (nIm1 - ninfm1)) * gammaAh * pIh * bHM -> A1gmI + ninfm1",
- "@ -> (A2hm - (nIm2 - ninfm2)) * gammaAh * pIh * bHM -> A2gmI + ninfm2",
-
- "A1gmI -> temperature > TAG ? A1gmI * (temperature - TAG) / TDDAG : 0 -> A1omI",
- paste0("A1omI -> A1omI * gammaAo -> A2hmI + ",gdata[["beta1"]]," * Neggs"), ## New eggs
- "A2gmI -> temperature > TAG ? A2gmI * (temperature - TAG) / TDDAG : 0 -> A2omI",
- paste0("A2omI -> A2omI * gammaAo -> A2hmI + ",gdata[["beta2"]]," * Neggs"), ## New eggs
-
- # Mortality
- "A1gmI -> mu1A * exp((temperature-10)*mu2A) < 0 ? A1gmI * mu3A : A1gmI * (mu1A * exp((temperature-10) * mu2A) + mu3A) -> @",
- "A1omI -> mu1A * exp((temperature-10)*mu2A) < 0 ? A1omI * (mu3A + muR) : A1omI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR) -> @",
- "A2hmI -> mu1A * exp((temperature-10)*mu2A) < 0 ? A2hmI * (mu3A + muR) : A2hmI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR) -> @",
- "A2gmI -> mu1A * exp((temperature-10)*mu2A) < 0 ? A2gmI * mu3A : A2gmI * (mu1A * exp((temperature-10) * mu2A) + mu3A) -> @",
- "A2omI -> mu1A * exp((temperature-10)*mu2A) < 0 ? A2omI * (mu3A + muR) : A2omI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR) -> @"
+ # 6/ Infection during blood meal of nulliparous female
+ # internal
+ # "@ -> Ih > 0 ? (A1hm - (nIm1 - ninfm1)) * gammaAh * pii * (Ih/(Sh+Eh+Ih+Rh)) * bHM : 0 -> A1gmE + ninfm1",
+ "@ -> Ih > 0 ? (A1hm - (nIm1 - ninfm1)) * gammaAh * pii * Ih/(Sh+Eh+Ih+Rh) * bHM * (1/mi_mixedpop) * atan((gammaAh * (A1hm + A2hm + A2hmE + A2hmI))/mi_mixedpop) * maxbite/(M_PI/2) : 0 -> A1gmE + ninfm1",
+
+ # external
+ "@ -> (A1hm - (nIm1 - ninfm1)) * gammaAh * betaHext * bHM -> A1gmE + ninfm1",
+
+ # 7/ Infection during blood meal of parous female
+ # internal
+ "@ -> Ih > 0 ? (A2hm - (nIm2 - ninfm2)) * gammaAh * pii * Ih/(Sh+Eh+Ih+Rh) * bHM * (1/mi_mixedpop) * atan((gammaAh * (A1hm + A2hm + A2hmE + A2hmI))/mi_mixedpop) * maxbite/(M_PI/2) : 0 -> A2gmE + ninfm2",
+ # external
+ "@ -> (A2hm - (nIm2 - ninfm2)) * gammaAh * betaHext * bHM -> A2gmE + ninfm2",
+
+ # 8 - 12/ from exposed to infectious
+ "A1gmE -> E2I > 0 ? A1gmE * 1/E2I : 0 -> A1gmI",
+ "A1omE -> G2O > 0 && ((E2I - 1/G2O) > 0) ? A1omE * 1/(E2I - 1/G2O) : ((G2O > 0 && (E2I - 1/G2O) <= 0) ? A1omE : 0 ) -> A1omI",
+ "A2hmE -> G2O > 0 && ((E2I - 1/G2O - (1/gammaAo)) > 0) ? A2hmE * 1/(E2I - 1/G2O - (1/gammaAo)) : ((G2O > 0 && ((E2I - 1/G2O - (1/gammaAo)) <= 0)) ? A2hmE : 0 ) -> A2hmI",
+ "A2gmE -> E2I > 0 ? A2gmE * 1/E2I : 0 -> A2gmI",
+ "A2omE -> G2O > 0 && ((E2I - 1/G2O) > 0) ? A2omE * 1/(E2I - 1/G2O) : ((G2O > 0 && (E2I - 1/G2O) <= 0) ? A2omE : 0 ) -> A2omI",
+
+ #### INFECTED MOSQUITOS DEVELOPMENT ####
+
+ # 13/ Egg maturing in nulliparous exposed female
+ "A1gmE -> G2O > 0 ? A1gmE * G2O : 0 -> A1omE",
+ # 14/ Oviposition of nulliparous exposed female
+ paste0("A1omE -> A1omE * gammaAo -> A2hmE + ",gdata[["beta1"]]," * Neggs"),
+ # 15/ Egg maturing in parous exposed female
+ "A2gmE -> G2O > 0 ? A2gmE * G2O : 0 -> A2omE",
+ # 16/ Oviposition of parous exposed female
+ paste0("A2omE -> A2omE * gammaAo -> A2hmE + ",gdata[["beta2"]]," * Neggs"),
+
+
+ # 17/ Egg maturing in nulliparous infectious female
+ "A1gmI -> G2O > 0 ? A1gmI * G2O : 0 -> A1omI",
+ # 18/ Oviposition of nulliparous infectious female
+ paste0("A1omI -> A1omI * gammaAo -> A2hmI + ",gdata[["beta1"]]," * Neggs"),
+ # 21/ Egg maturing in parous infectious female
+ "A2gmI -> G2O > 0 ? A2gmI * G2O : 0 -> A2omI",
+ # 22/ Oviposition of parous infectious female
+ paste0("A2omI -> A2omI * gammaAo -> A2hmI + ",gdata[["beta2"]]," * Neggs"),
+
+ # 23 - 32/ Mortality
+
+ "A1gmE -> (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) > 1 ? A1gmE : A1gmE * (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) -> @",
+ "A1omE -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A1omE : A1omE * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @",
+ "A2hmE -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A2hmE : A2hmE * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @",
+ "A2gmE -> (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) > 1 ? A2gmE : A2gmE * (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) -> @",
+ "A2omE -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A2omE : A2omE * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @",
+
+ "A1gmI -> (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) > 1 ? A1gmI : A1gmI * (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) -> @",
+ "A1omI -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A1omI : A1omI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @",
+ "A2hmI -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A2hmI : A2hmI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @",
+ "A2gmI -> (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) > 1 ? A2gmI : A2gmI * (mu1A * exp((temperature-10) * mu2A) + mu3A + interv_Am) -> @",
+ "A2omI -> (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) > 1 ? A2omI : A2omI * (mu1A * exp((temperature-10) * mu2A) + mu3A + muR + interv_Am) -> @"
+
)
return(stoch_transitions)
diff --git a/R/check_PARCELLE.R b/R/check_PARCELLE.R
deleted file mode 100644
index 68dfa7722ac2ce2e8cb31c3a61eea4f66fbb0f88..0000000000000000000000000000000000000000
--- a/R/check_PARCELLE.R
+++ /dev/null
@@ -1,27 +0,0 @@
-#' Check PARCELLE object
-#'
-#' @description function to check format of PARCELLE object
-#'
-#' @param PARCELLE percelle object (data.frame or data.table)
-#'
-#'
-#' @noRd
-
-
-check_PARCELLE <- function(PARCELLE){
-
- if(!(is.data.frame(PARCELLE) | is.data.table(PARCELLE) | inherits(PARCELLE, "SpatVector")))
- stop("PARCELLE must be a data.table or a data.frame")
-
- if(inherits(PARCELLE, "SpatVector")){
- shape <- PARCELLE
- PARCELLE %<>% as.data.frame
- }
-
- PARCELLE <- copy(PARCELLE)
- setDT(PARCELLE)
-
- if(NA %in% match(c("ID", "POP", "SURF_HA", "KLfix", "KLvar", "KPfix", "KPvar", "STATION", "DIFF_ALT"), names(PARCELLE)))
- stop('PARCELLE must contain at least 16 columns: "ID", "POP", "SURF_HA", "KLfix", "KLvar", "KPfix", "KPvar", "STATION", "DIFF_ALT"')
-
-}
diff --git a/R/check_control.R b/R/check_control.R
new file mode 100644
index 0000000000000000000000000000000000000000..0c032d40504b7fc3db9792d86700fe0217144f1f
--- /dev/null
+++ b/R/check_control.R
@@ -0,0 +1,119 @@
+#' Check prev_control object
+#'
+#' @description Function to check the format and validity of the `prev_control` object.
+#'
+#' @param prev_control A `data.frame` or `data.table` describing preventive control measures implemented. Required columns: 'action', 'loc', 'start', 'end', 'p'.
+#' @param sim_period A vector of dates specifying the simulation period. It should be in `Date` format.
+#'
+#' @details
+#' The `prev_control` object should contain the following columns:
+#' \itemize{
+#' \item 'action': A character vector with values 'K', 'L', or 'A'. 'K' denotes source reduction; 'L' denotes chemical larviciding; 'A' denotes fogging or area spraying.
+#' \item 'loc': A character vector with parcel IDs. These should match IDs in the relevant dataset.
+#' \item 'start': A `Date` vector indicating the start date of the measure.
+#' \item 'end': A `Date` vector indicating the end date of the measure.
+#' \item 'p': A numeric vector between 0 and 1. Represents the proportion of sites removed (for 'K'), additional mortality of adults (for 'A'), or additional mortality of larvae (for 'L').
+#' }
+#'
+#' @importFrom data.table is.data.table copy setDT
+#' @importFrom stats na.omit
+#'
+#' @noRd
+#'
+check_prev_control <- function(prev_control, sim_period) {
+
+ # Ensure prev_control is a data.table
+ if (!is.data.table(prev_control)) {
+ if (is.data.frame(prev_control)) {
+ prev_control <- setDT(copy(prev_control))
+ } else {
+ stop("prev_control must be a data.table or a data.frame")
+ }
+ }
+
+ # Check required columns
+ required_cols <- c("action", "loc", "start", "end", "p")
+ missing_cols <- setdiff(required_cols, names(prev_control))
+ if (length(missing_cols) > 0) {
+ stop(paste("prev_control must contain the following columns:", paste(missing_cols, collapse = ", ")))
+ }
+
+ # Check 'action' column
+ if (!all(prev_control$action %in% c("K", "L", "A"))) {
+ stop("'prev_control$action' must be one of 'K', 'L', or 'A'")
+ }
+
+ # Check 'start' and 'end' columns
+ if (!inherits(prev_control$start, "Date") || !inherits(prev_control$end, "Date")) {
+ stop("'prev_control$start' and 'prev_control$end' must be in Date format")
+ }
+
+ # Check that start and end dates are within the simulation period
+ if (any(prev_control$start < min(sim_period) | prev_control$end > max(sim_period))) {
+ stop("In prev_control, start and end dates must be within the simulation period.")
+ }
+
+ # Check 'p' column
+ if (!is.numeric(prev_control$p) || any(prev_control$p < 0 | prev_control$p > 1)) {
+ stop("'prev_control$p' must be numeric and between 0 and 1")
+ }
+
+ # Check that start dates precede end dates
+ if (any(prev_control$start > prev_control$end)) {
+ stop("Start date must precede end date in prev_control table.")
+ }
+
+ check_overlapping_actions <- function(prev_control) {
+ # Helper function to check for overlaps within a subset of actions
+ overlapping <- function(df) {
+ df <- df[order(start, end)]
+ overlaps <- FALSE
+ for (i in 1:(nrow(df) - 1)) {
+ if (df$end[i] >= df$start[i + 1]) {
+ overlaps <- TRUE
+ break
+ }
+ }
+ return(overlaps)
+ }
+
+ # Identify overlapping actions
+ overlaps_found <- FALSE
+ # Extract unique actions and locations
+ unique_actions <- unique(prev_control[, .(action, loc)])
+
+ for (i in seq_len(nrow(unique_actions))) {
+ action_loc <- unique_actions[i, ]
+ # Subset control measures by action and location
+ subset_control <- prev_control[action == action_loc$action & loc == action_loc$loc]
+
+ if (nrow(subset_control) > 1) {
+ # Check for overlapping periods if more than one action exists
+ if (overlapping(subset_control)) {
+ message <- paste("Overlapping actions detected in parcel:", action_loc$loc,
+ "for action:", action_loc$action, "\n",
+ capture.output(print(subset_control)), collapse = "\n")
+ stop(message)
+ }
+ }
+ }
+
+ return(invisible(overlaps_found))
+ }
+
+ check_overlapping_actions(prev_control)
+
+ # Example usage
+ # prev_control should be a data.table with columns: action, loc, start, end
+ # Replace with your actual data
+ # prev_control <- data.table(action = ..., loc = ..., start = ..., end = ...)
+ # check_overlapping_actions(prev_control)
+
+
+ # Optional: Check for duplicates in the `prev_control` table
+ # if (anyDuplicated(prev_control)) {
+ # stop("Duplicate rows found in prev_control.")
+ # }
+
+ return(TRUE)
+}
diff --git a/R/check_gdata.R b/R/check_gdata.R
index aa5d3543310d84bf59a1f78496a5d6c30527390d..80adbbc7a61140bf64c23a6de9e11f6fedad13c4 100644
--- a/R/check_gdata.R
+++ b/R/check_gdata.R
@@ -1,33 +1,41 @@
#' Check and build gdata
#'
-#' @description function to build gdata
+#' @description Function to check and build the `gdata` object based on the provided vector and virus types.
#'
-#' @param gdata list
-#' @param vector_species string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.
-#' @param climat string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.
+#' @param gdata A list of global parameters. If NULL, will be built using `build_gdata`.
+#' @param vector A string indicating the mosquito vector. One of "Ae. albopictus", "Ae. albopictus (D)", or "Ae. aegypti". Default is "Ae. albopictus".
+#' @param virus A string indicating the virus type. One of "DEN" (dengue), "ZIK" (zika), or "CHI" (chikungunya). Default is "DEN".
+#' @param verbose Logical. If TRUE, will print additional information during the process. Default is TRUE.
#'
-#' @return gdata
+#' @return The validated `gdata` list.
#'
#' @noRd
+#'
+check_gdata <- function(gdata, vector = "Ae. albopictus", virus = "DEN", verbose = TRUE) {
+ # Check if gdata is NULL
+ if (is.null(gdata)) {
+ if (is.null(vector)) {
+ stop("If 'vector' is NULL, a set of global parameters ('gdata') must be provided.")
+ }
+ # Validate vector input
+ if (!vector %in% c("Ae. albopictus", "Ae. albopictus (D)", "Ae. aegypti")) {
+ stop(paste("Parameters for", vector, "haven't been implemented. Please provide a valid set of 'gdata' parameters or choose 'Ae. albopictus', 'Ae. albopictus (D)', or 'Ae. aegypti'."))
+ }
-check_gdata <- function(gdata, vector_species, climate, verbose = T){
- if(is.null(gdata)){
- if(is.null(vector_species))
- stop("If vector_species is NULL, a set of global parameters gdata must be provided")
-
- if(vector_species == "Ae. albopictus" & climate == "temperate"){
- gdata <- build_gdata(vector_species = vector_species,
- climate = climate,
- verbose = verbose)
- } else
- stop(paste("Parameters for", vector_species, "in", climate, " climate haven't been implemented, please provide a set of gdata parmaeters or choose 'Ae. albopictus' vector_species"))
+ # Build gdata using the specified vector and virus
+ gdata <- build_gdata(vector = vector, virus = virus, verbose = verbose)
}
- if(NA %in% match(build_gdata(verbose = F) %>% names, names(gdata)))
- stop('gdata must contain at least the following parameters:
- "bMH", "muH", "rhoH", "muE", "TE", "TDDE", "mu1L", "mu2L", "mu3L", "q1L", "q2L", "q3L", "muEM", "mu1P", "mu2P", "mu3P", "q1P", "q2P", "q3P", "mu1A", "mu2A", "mu3A", "gammaAem", "sigma", "gammaAh", "muR", "TAG", "TDDAG", "gammaAo", "beta1","beta2","bHM" \n
- You can use the function build_gdata to generate a well formated dataset')
+ # Retrieve the required parameter names
+ required_params <- names(build_gdata(vector = vector, virus = virus, verbose = FALSE))
+
+ # Check if gdata contains all required parameters
+ missing_params <- setdiff(required_params, names(gdata))
+ if (length(missing_params) > 0) {
+ stop(paste("gdata must contain the following parameters:", paste(missing_params, collapse = ", "), ".\n",
+ "You can use the function `build_gdata` to generate a properly formatted dataset."))
+ }
- gdata
+ return(gdata)
}
diff --git a/R/check_parcels.R b/R/check_parcels.R
new file mode 100644
index 0000000000000000000000000000000000000000..cb1b48130823590fa8fff36c3379787131ac4a27
--- /dev/null
+++ b/R/check_parcels.R
@@ -0,0 +1,56 @@
+#' Check parcels object
+#'
+#' @description Function to check the format of the parcels object.
+#'
+#' @param parcels A `data.frame`, `data.table`, or `SpatVector` object describing the patches.
+#'
+#' @importFrom data.table is.data.table copy setDT
+#'
+#' @noRd
+#'
+check_parcels <- function(parcels) {
+
+ # Check if parcels is one of the accepted types
+ if (!inherits(parcels, c("data.table", "data.frame", "SpatVector"))) {
+ stop("parcels must be a data.table, data.frame, or SpatVector")
+ }
+
+ # Convert SpatVector to data.frame if needed
+ if (inherits(parcels, "SpatVector")) {
+ parcels <- as.data.frame(parcels)
+ }
+
+ # Convert to data.table
+ setDT(parcels)
+
+ # Check for required columns
+ required_cols <- c("ID", "POP", "Kfix", "Kvar")
+ if (!all(required_cols %in% names(parcels))) {
+ stop(paste('parcels must contain at least the following columns:', paste(required_cols, collapse = ", ")))
+ }
+
+ # Check if ID column is of character type
+ if (!is.character(parcels$ID)) {
+ stop('parcels$ID must be a character vector')
+ }
+
+ # Check if STATION column exists and is of character type
+ if ("STATION" %in% names(parcels) && !is.character(parcels$STATION)) {
+ stop('parcels$STATION must be a character vector if present')
+ }
+
+ # Optional: Check the types of other columns if needed
+ if (!is.numeric(parcels$POP)) {
+ stop('parcels$POP must be a numeric vector')
+ }
+ if (!is.numeric(parcels$Kfix)) {
+ stop('parcels$Kfix must be a numeric vector')
+ }
+ if (!is.numeric(parcels$Kvar)) {
+ stop('parcels$Kvar must be a numeric vector')
+ }
+
+ # If needed, you can add more checks here
+
+ invisible(TRUE) # Return TRUE invisibly if all checks pass
+}
diff --git a/R/cleanmeteo.R b/R/cleanmeteo.R
deleted file mode 100644
index 4020ef9597dc0be6b7dfa9ba4d0711723d548072..0000000000000000000000000000000000000000
--- a/R/cleanmeteo.R
+++ /dev/null
@@ -1,50 +0,0 @@
-#'Clean meteorological data
-#'
-#' @description Clean meteorological data
-#'
-#' @usage cleanmeteo(meteo)
-#'
-#' @param meteo
-#'
-#' @return meteo
-#'
-#' @importFrom imputeTS na_ma
-#' @import data.table
-#'
-#' @export
-#'
-#' @noRd
-
-
-# Clean meteorological data
-
-cleanmeteo <- function(meteo){
-
- setDT(meteo)
-
- ### Clean meteorological data
- ## Count the maximal number of consecutive missing values per stations
- meteo[, `:=`(naRR = ifelse(TRUE %in% is.na(RR),
- max(rle(is.na(RR))$length[rle(is.na(RR))$value]),
- 0),
- naTX = ifelse(TRUE %in% is.na(TX),
- max(rle(is.na(TX))$length[rle(is.na(TX))$value]),
- 0),
- naTN = ifelse(TRUE %in% is.na(TN),
- max(rle(is.na(TN))$length[rle(is.na(TN))$value]),
- 0)), by = POSTE]
-
- ## Remove stations with more than 10 consecutive missing values
- meteo %<>% .[naRR < 10 & naTX < 10 & naTN < 10]
- meteo$POSTE %>% unique %>% length
-
- ## Use imputeTS package to impute the missing values
- meteo[, RR := na_ma(RR) , by=POSTE]
- meteo[, TN := na_ma(TN) , by=POSTE]
- meteo[, TX := na_ma(TX) , by=POSTE]
-
- ## Remove unused columns
- meteo[, ':='(naRR = NULL, naTX=NULL, naTN = NULL)]
-
-return(meteo)
-}
diff --git a/R/create_ldata.R b/R/create_ldata.R
index 26fc1ac3ad6e48b04cdc5b37b91e9d3d23665c08..acd8cc8e2957921a178089488d2909fd525cf65a 100644
--- a/R/create_ldata.R
+++ b/R/create_ldata.R
@@ -1,125 +1,115 @@
-#' Write local data matrix
-#'
-#' @description Function to define local data
-#'
-#' @usage create_ldata(PARCELLE, METEO, gdata, mMov, TS_sim)
-#'
-#' @param PARCELLE data.frame or data.table
-#' @param METEO data.frame or data.table
-#' @param gdata list
-#' @param mMov list of two matrices. Probabilities of location of individuals.
-#' proba_ij is the probabilities of individuals from i (columns) to be bitten in j (rows).
-#' proba_ji is the probabilities for mosquito in i (rows) to bite an individual from j (columns).
-#' Row sums should be equal to 1.
-#' @param TS_sim list. four vectors of simulated dates (dates) and simulated days (numeric) with and without the initialization period
-#'
-#' @importFrom pbapply pbapply
-#' @importFrom parallel makeCluster
-#' @importFrom parallel detectCores
-#' @importFrom parallel clusterExport
-#' @importFrom parallel clusterEvalQ
-#' @importFrom parallel stopCluster
-#' @importFrom magrittr is_less_than
-#' @importFrom zoo rollapply
-#'
-#' @return matrix
-#'
-#' @keywords ldata METEO
-#'
-#' @noRd
-
-
-
-create_ldata <- function(PARCELLE, METEO, gdata, mMov, TS_sim){
- ## We have seven variables that we want to incorporate in each node.
- ## Create a matrix for each variable, where each column contains the data for one node.
-
- ## Format
-
- PARCELLE %<>% copy
- PARCELLE %>% setDT
-
- METEO %<>% copy
- setDT(METEO)
+#' @importFrom data.table data.table
+
+create_ldata <- function(parcels, meteo, gdata, mMov, TS_sim, prev_control){
+
+ parcels %<>% copy
+ parcels %>% setDT
+
+ meteo %<>% unique
+ meteo %<>% copy
+ setDT(meteo)
## CHECKS
+ meteorological_records <- ifelse("STATION" %in% names(parcels), TRUE , FALSE)
- if(NA %in% match(PARCELLE$STATION, METEO$ID))
- stop("Some stations are missing from the meteorological dataset")
+ PARCELS_ID <- if(meteorological_records) "STATION" else "ID"
- if(METEO[ID %in% PARCELLE$STATION, .N, by = ID] %>% .[,N] %>% min %>% is_less_than(365))
- stop("At least one year of meteorological data are required for initialization")
+ if(NA %in% match(parcels[,PARCELS_ID, with = FALSE] %>% unlist, meteo$ID))
+ stop("Some parcels do not have any records in the meteorological dataset")
- if(FALSE %in% (as.IDate(TS_sim$time_serie_output_d) %in% METEO[ID %in% PARCELLE$STATION, DATE]))
- stop("meteorological data are required for each day of the simulated period")
+ if(meteo[ID %in% (parcels[,PARCELS_ID, with = FALSE] %>% unlist), .N, by = ID] %>% .[,N] %>% min < 365)
+ stop("At least one year of meteorological data is required for initialization")
+
+ if(FALSE %in%
+ (as.IDate(TS_sim$time_serie_output_d) %in% meteo[ID %in% (parcels[,PARCELS_ID, with = FALSE] %>% unlist), DATE]))
+ stop("Meteorological data are required for each day of the simulated period")
## CALCULATION
- ## for each administrative unit
message("## Generating parameters for all patches can take time, please be patient. ##")
- # Normalize precipitation
- METEO[,RR := RR/max(RR)]
-
t_sim <- length(TS_sim$time_serie_date)
-
# Initialization period
- METEO <- expand.grid(DATE = TS_sim$time_serie_date,
- ID = METEO$ID %>% unique) %>% merge(., METEO, all.x = T)
- setDT(METEO)
+ meteo_baseline <- meteo
- ldata <- pbapply(PARCELLE, 1, function(x){
+ meteo_grid <- expand.grid(DATE = TS_sim$time_serie_date,
+ ID = meteo$ID %>% unique)
- while(TRUE %in% METEO[ID == x["STATION"] %>% as.numeric, is.na(RR)]){
- NA_start <- METEO[ID == x["STATION"] %>% as.numeric & is.na(RR), DATE %>% as.IDate] %>% min %>% format(., "%m-%d")
- NA_length <- METEO[ID == x["STATION"] %>% as.numeric & is.na(RR), DATE] %>% length
+ meteo <- merge(meteo_grid, meteo %>% unique, by = c("ID", 'DATE'), all.x = TRUE)
+ setDT(meteo)
- NA_start <- which(METEO[ID == x["STATION"] %>% as.numeric & !is.na(RR), DATE %>% as.IDate %>% format(., "%m-%d")] == NA_start) %>% min
+ ldata <- pbapply(parcels, 1, function(x){
- METEO[ID == x["STATION"] %>% as.numeric & is.na(RR), c("RR", "TP")] <-
- METEO[ID == x["STATION"] %>% as.numeric & !is.na(RR), c("RR", "TP")][seq(NA_start:(NA_start+(NA_length-1))),]
- }
+ # Replace NA values for initialization period if missing from meteorological data
+ while(TRUE %in% meteo[ID == x[PARCELS_ID], is.na(RR)]){
- # Daily temperature corrected by the altitude '(4.2/1000)' is in Ocelet code
- METEO[ID == x["STATION"] %>% as.numeric, TP := TP - as.numeric(x["DIFF_ALT"])*(4.2/1000)]
+ NA_start <- meteo[ID == x[PARCELS_ID] & is.na(RR), DATE %>% as.IDate] %>% min %>% format(., "%m-%d")
+ NA_length <- meteo[ID == x[PARCELS_ID] & is.na(RR), DATE] %>% length
- temperature <- METEO[ID == x["STATION"] %>% as.numeric, TP]
+ NA_start <- meteo[ID == x[PARCELS_ID] & !is.na(RR), which(DATE %>% as.IDate %>% format(., "%m-%d") %>% equals(NA_start))[1]]
- # Cumulative rainfall over 7 days
- raincumul7 <- rollapply(c(rep(0,6), METEO[ID == x["STATION"] %>% as.numeric, RR]), 7, sum)
+ meteo[ID == x[PARCELS_ID] & is.na(RR), c("RR", "TP")] <-
+ meteo_baseline[ID == x[PARCELS_ID] & !is.na(RR), c("RR", "TP")][NA_start:(NA_start + (NA_length-1))]
+ }
- # Simplify with unique carrying capacity value
- kfix <- x["KLfix"] %>% as.numeric
- kvar <- x["KLvar"] %>% as.numeric
+ # Adjust temperature for altitude
+ if(meteorological_records){
+ temperature <- meteo[ID == x[PARCELS_ID], TP - as.numeric(x["DIFF_ALT"]) * (4.2 / 1000)]
+ } else {
+ temperature <- meteo[ID == x[PARCELS_ID], TP]
+ }
+
+ # Collect rainfall data
+ rain <- meteo[ID == x[PARCELS_ID], RR]
+
+ # Simplify carrying capacities
+ kfix <- as.numeric(x["Kfix"])
+ kvar <- as.numeric(x["Kvar"])
c(t_sim,
- # carrying capacities
kfix, kvar,
- # Temperature
temperature,
- # Carrying capacities related to rainfall
- raincumul7
+ rain
) %>% as.numeric
-
})
- colnames(ldata) <- PARCELLE$ID
+ colnames(ldata) <- parcels$ID
+
+ # Add two rows
+ ldata %<>% rbind(matrix(0, nrow = 3, ncol = ncol(ldata)), .)
+ ldata[1,] <- ldata[4,]
+ ldata[2,] <- diag(mMov$proba_ij[parcels$ID, parcels$ID])
+ ldata[3,] <- diag(mMov$proba_ji[parcels$ID, parcels$ID])
+ ldata[4,] <- mMov$mi_mixedpop[parcels$ID]
- ldata %<>% .[c(1,1,seq(nrow(ldata))),]
+ proba_ij <- mMov$proba_ij[parcels$ID, parcels$ID] %>% t
+ proba_ji <- mMov$proba_ji[parcels$ID, parcels$ID] %>% t
- ldata[2,] <- diag(mMov$proba_ij)
- ldata[3,] <- diag(mMov$proba_ji)
+ diag(proba_ij) <- diag(proba_ji) <- 0
+
+ ldata <- rbind(ldata, proba_ij, proba_ji)
+
+ # Add prev_control measures
+ if(!is.null(prev_control)){
+ CSS <- data.table(matrix(0, nrow = prev_control[, .N], ncol = ncol(ldata)))
+ setnames(CSS, colnames(ldata))
+
+ for(x in seq_len(nrow(prev_control))){
+ CSS[x, which(names(CSS) == prev_control[x, loc])] <- prev_control[x, p]
+ }
- ldata %<>% rbind(., t(mMov$proba_ij[,colnames(ldata)]))
- ldata %<>% rbind(., t(mMov$proba_ji[,colnames(ldata)]))
+ ldata <- rbind(ldata, as.matrix(CSS))
+ }
- rownames(ldata) <- c("n_days", "pOii","pDii",
+ rownames(ldata) <- c("n_days",
+ "p2stay","pii", "mi_mixedpop",
"kfix", "kvar",
paste0("Tp_", seq(t_sim)),
- paste0("RR7_", seq(t_sim)),
- paste0("Oij_", PARCELLE$ID),
- paste0("Dij_", PARCELLE$ID)
+ paste0("RR_", seq(t_sim)),
+ paste0("Oij_", parcels$ID),
+ paste0("Dij_", parcels$ID),
+ if(!is.null(prev_control)) paste0("CSS_", seq_len(nrow(prev_control)))
)
return(ldata)
diff --git a/R/data.R b/R/data.R
new file mode 100644
index 0000000000000000000000000000000000000000..5de7fb8fe66ccd70b6ad2205fbf588d855b82979
--- /dev/null
+++ b/R/data.R
@@ -0,0 +1,50 @@
+#' Parcelle data
+#'
+#' @name parcels
+#' @docType data
+#' @format data frame with columns:
+#' \describe{
+#' \item{ID}{unique identifier for each parcel}
+#' \item{NOM_COM}{Name of the city associated to the parcel}
+#' \item{SURF_HA}{surface in hectare (optional)}
+#' \item{STATION}{unique identifier of the meteorological station associated to the parcel (optional)}
+#' \item{DIFF_ALT}{difference between average altitude of the parcel and the altitude of the associated meteorological station (optional)}
+#' \item{ALT}{average altitude of the parcel (optional)}
+#' \item{Kfix}{Fix carrying capacity (number of larvae in anthropic breeding sites)}
+#' \item{Kvar}{Varying carrying capacity (number of larvae in natural breeding sites)}
+#' \item{POP}{Human population size}
+#' }
+#' @source iris-ge, urban atlas, CLC
+#' @keywords data
+
+NULL
+
+#' Meteorological data
+#'
+#' @name meteo
+#' @docType data
+#' @format data frame with columns:
+#' \describe{
+#' \item{ID}{unique identifier per meteorological station}
+#' \item{DATE}{date of the meteorological record}
+#' \item{RR}{Daily precipitation/rainfall (in mm)}
+#' \item{TP}{DAily average temperature (in degree)}
+#' }
+#' @source meteofrance
+#' @keywords data
+
+NULL
+
+
+#' Carrying capacity estimates per land cover type
+#'
+#' @name configK
+#' @docType data
+#' @format data frame with columns:
+#' \describe{
+#' \item{ID}{...}
+#' }
+#' @source mtd
+#' @keywords data
+
+NULL
diff --git a/R/diapause.R b/R/diapause.R
index 6e0fd24ff38288a608704bf3b67aaa661d94b0b6..a6624883030141516b909385e0a808d8d3850030 100644
--- a/R/diapause.R
+++ b/R/diapause.R
@@ -13,16 +13,18 @@
#' @keywords diapause
#'
#' @importFrom magrittr subtract
-#' @importFrom magrittr %>%
#' @importFrom data.table as.IDate
#'
#' @noRd
diapause <- function(startFav, endFav, TS_sim){
- startFav <- which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(startFav), "%m-%d"))
- endFav <- which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(endFav), "%m-%d"))
- x <- c(startFav, endFav) %>% .[order(.)]
+ # startFav <- which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(startFav), "%m-%d"))
+ # endFav <- which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(endFav), "%m-%d"))
+
+ x <- c(which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(startFav), "%m-%d")),
+ which(format(TS_sim$time_serie_date, "%m-%d") == format(as.IDate(endFav), "%m-%d"))) %>%
+ .[order(.)]
return(x)
}
diff --git a/R/estim_K.R b/R/estim_K.R
new file mode 100644
index 0000000000000000000000000000000000000000..1b32bf22b70c255d5ba70d201ba6dd459dc2d1c4
--- /dev/null
+++ b/R/estim_K.R
@@ -0,0 +1,156 @@
+#' Estimate spatial carrying capacities
+#'
+#' @description Function used to estimate carrying capacity from soil occupation classes
+#'
+#' @param PARCELS_SHAPE SpatVector object with polygons of parcels
+#' @param URBAN_ATLAS SpatVector object or list of SpatVector objects with polygons of soil occupation class by urban atlas
+#'
+#' @return SpatVector object
+#'
+#' @importFrom terra project expanse erase crop mask activeCat levels addCats zonal rast relate aggregate
+#' @importFrom magrittr multiply_by is_in not
+#'
+#' @keywords carrying capacity
+#'
+#'
+#' @examples
+#' \dontrun{
+#' PARCELS_SHAPE <- system.file("shape/SpatVec.shp", package = "arbocartoR") %>% vect
+#' PARCELS_SHAPE_K_ESTIM <- estim_K(PARCELS_SHAPE, URBAN_ATLAS)
+#' }
+#'
+#' @export
+
+estim_K <- function(PARCELS_SHAPE,
+ URBAN_ATLAS = NULL){
+
+ names_SHAPE <- names(PARCELS_SHAPE)
+
+ if(!is.null(URBAN_ATLAS)){
+
+ if(inherits(URBAN_ATLAS, 'SpatVector')){
+ URBAN_ATLAS_list <- list(URBAN_ATLAS)
+ } else URBAN_ATLAS_list <- URBAN_ATLAS
+
+ for(i in seq_along(URBAN_ATLAS_list)){
+
+ URBAN_ATLAS <- URBAN_ATLAS_list[[i]]
+
+ ## HARMONIZE PROJECTIONS ##
+ URBAN_ATLAS %<>% project(PARCELS_SHAPE)
+
+ if(intersect(PARCELS_SHAPE, URBAN_ATLAS) %>% length() %>% magrittr::equals(0))
+ next
+ # stop("URBAN_ATLAS and PARCELS_SHAPE do not intersect, consider using another urban atlas shapefile or URBAN_ATLAS = FALSE")
+
+ ## CROP URBAN ATLAS ##
+ URBAN_ATLAS %<>% crop(., PARCELS_SHAPE, ext = 2)
+ gc()
+
+ ## CHECK IF PARCELS ARE FULLY COVERED BY URBAN ATLAS ##
+ PARCELS_ARE_COVERED <- URBAN_ATLAS %>% aggregate %>% relate(PARCELS_SHAPE, ., relation ="coveredby") %>% is_in(FALSE, .) %>% not
+ gc()
+
+ ## CREATE A MASK ##
+ URBAN_ATLAS %<>% mask(., PARCELS_SHAPE)
+ gc()
+
+ # SELECT COLUMNS
+ URBAN_ATLAS %<>% .[, "code_2018"]
+ gc()
+
+ # BIND URBAN ATLAS WITH CC TABLE
+ URBAN_ATLAS %<>% cbind(., configK[match(.$code_2018, CODE), ])
+ gc()
+
+ # ADD POLYGONS SURFACE
+ URBAN_ATLAS$AREA <- expanse(URBAN_ATLAS, "ha")
+ gc()
+
+ # CALCULATE Kfix
+ URBAN_ATLAS$Kfix <- URBAN_ATLAS$nbL_ha * URBAN_ATLAS$AREA * URBAN_ATLAS$p_gite_anthro
+ # CALCULATE Kvar
+ URBAN_ATLAS$Kvar <- URBAN_ATLAS$nbL_ha * URBAN_ATLAS$AREA * (1 - URBAN_ATLAS$p_gite_anthro)
+
+ PARCELS_SHAPE %<>% project(URBAN_ATLAS)
+ gc()
+
+ if('Kfix' %in% names(PARCELS_SHAPE) & 'Kvar' %in% names(PARCELS_SHAPE)){
+ zonal_UA <- zonal(URBAN_ATLAS[,c("Kfix", "Kvar")], PARCELS_SHAPE[, -which(names(PARCELS_SHAPE) %in% c('Kfix', 'Kvar'))], fun = sum, na.rm=TRUE, as.polygons = T)
+ gc()
+
+ PARCELS_SHAPE$Kfix <- rowSums(data.frame(PARCELS_SHAPE$Kfix, zonal_UA$Kfix), na.rm = TRUE) * NA ^ (rowSums(!is.na(data.frame(PARCELS_SHAPE$Kfix, zonal_UA$Kfix))) == 0)
+ PARCELS_SHAPE$Kvar <- rowSums(data.frame(PARCELS_SHAPE$Kvar, zonal_UA$Kvar), na.rm = TRUE) * NA ^ (rowSums(!is.na(data.frame(PARCELS_SHAPE$Kvar, zonal_UA$Kvar))) == 0)
+
+ } else {
+ PARCELS_SHAPE <- zonal(URBAN_ATLAS[,c("Kfix", "Kvar")], PARCELS_SHAPE,
+ fun = sum, na.rm=TRUE, as.polygons = T)
+ }
+
+ ## IF ALL PARCELS ARE NOT COVERED BY UA
+ if(!PARCELS_ARE_COVERED){
+ # EXTRACT AREAS NOT COVERED BY UA
+ PARCELS_SHAPE_NO_UA <- PARCELS_SHAPE[is.na(PARCELS_SHAPE$Kfix),]#erase(PARCELS_SHAPE, URBAN_ATLAS)
+ gc()
+ } else PARCELS_SHAPE_NO_UA <- NULL
+ }
+ } else {
+ PARCELS_SHAPE_NO_UA <- PARCELS_SHAPE
+ }
+
+ if(!is.null(PARCELS_SHAPE_NO_UA)){
+ ## LOAD CLC
+ CLC_raster <- system.file("clc/U2018_CLC2018_V2020_20u1.tif", package = "arbocartoR") %>% rast(., "CODE_18")
+
+ # PROJECT
+ PARCELS_SHAPE_NO_UA %<>% project(CLC_raster)
+
+ # CROP & MASK
+ CLC_raster %<>% crop(., PARCELS_SHAPE_NO_UA)
+ CLC_raster %<>% mask(., PARCELS_SHAPE_NO_UA)
+
+ suppressWarnings(CLC_raster %<>% project(PARCELS_SHAPE))
+
+ # cats(CLC_raster)
+
+ # SELECT THE CODE CATEGORY
+ terra::activeCat(CLC_raster, layer=1) <- "CODE_18"
+
+ # MERGE WITH THE CONFIGURATION TABLE
+ table_raster_lev <- terra::levels(CLC_raster)[[1]]
+ table_raster_lev$CODE_18 %<>% as.numeric %>% multiply_by(100)
+
+ ## LOAD CARRYING CAPACITY X SOIL OCCUPATION TABLE
+ # data("configCC")
+
+ CLC_cats <- merge(table_raster_lev, configK, by.x = "CODE_18", by.y = "CODE", all.x = T) %>%
+ replace(is.na(.), 0)
+
+ CLC_cats %<>% .[, c(which(colnames(.) %in% c("Value", "CODE_18")),
+ which(!colnames(.) %in% c("Value", "CODE_18")))]
+
+ CLC_raster %<>% addCats(.,
+ CLC_cats,
+ merge=F, layer=1)
+ # cats(CLC_raster)
+
+ terra::activeCat(CLC_raster, layer=1) <- "Klfix"
+ PARCELS_SHAPE$CLC_Klfix <- zonal(CLC_raster, PARCELS_SHAPE, fun = sum, na.rm=TRUE)
+
+ terra::activeCat(CLC_raster, layer=1) <- "Klvar"
+ PARCELS_SHAPE$CLC_Klvar <- zonal(CLC_raster, PARCELS_SHAPE, fun = sum, na.rm=TRUE)
+
+ if(!is.null(URBAN_ATLAS)){
+ PARCELS_SHAPE$Kfix <- rowSums(cbind(PARCELS_SHAPE$CLC_Klfix,PARCELS_SHAPE$Kfix), na.rm=TRUE)
+ PARCELS_SHAPE$Kvar <- rowSums(cbind(PARCELS_SHAPE$CLC_Klvar,PARCELS_SHAPE$Kvar), na.rm=TRUE)
+ } else {
+ PARCELS_SHAPE$Kfix <- PARCELS_SHAPE$CLC_Klfix
+ PARCELS_SHAPE$Kvar <- PARCELS_SHAPE$CLC_Klvar
+ }
+
+ }
+
+ PARCELS_SHAPE %<>% .[c(names_SHAPE, "Kfix", "Kvar")]
+
+ return(PARCELS_SHAPE)
+}
diff --git a/R/fadult.R b/R/fadult.R
new file mode 100644
index 0000000000000000000000000000000000000000..9ea1c4a5938a85bae65047435a306adfce3504dc
--- /dev/null
+++ b/R/fadult.R
@@ -0,0 +1,28 @@
+#' Function for adult gorging
+#'
+#' @description Function to write the temperature dependency for adult gorging depending on the species
+#'
+#' @param vector string vector species
+#' @param gdata list of global data
+#'
+#' @return string
+#'
+#' @noRd
+
+fadult <- function(vector, gdata){
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+ options(scipen=999)
+ fadult <- paste0('((temperature - ', gdata["TAG"], ')/', gdata["TDDAG"], ')')
+ options(scipen=0)
+ }
+
+ if(vector == "Ae. aegypti"){
+ options(scipen=999)
+
+ tempK = '(temperature + 273.15)'
+ fadult <- paste('((',gdata["q1Ag"],'*', tempK, ' * ',gdata["q2Ag"],') * exp(',gdata["q3Ag"],' * (',gdata["q4Ag"],' - 1 / ',tempK,')) / (1 + exp(',gdata["q5Ag"],' * (',gdata["q6Ag"],' - 1 / ',tempK,'))))')
+ options(scipen=0)
+ }
+
+ return(fadult)
+}
diff --git a/R/feggs.R b/R/feggs.R
new file mode 100644
index 0000000000000000000000000000000000000000..1967395b1959d0a08e6790bf5713b689eb5103a5
--- /dev/null
+++ b/R/feggs.R
@@ -0,0 +1,30 @@
+#' Function for eggs development
+#'
+#' @description Function to write the temperature dependency for eggs development depending on the species
+#'
+#' @param vector string vector species
+#' @param gdata list of global data
+#'
+#' @return string
+#'
+#' @noRd
+
+feggs <- function(vector, gdata){
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+ options(scipen=999)
+ feggs <- paste0('((temperature - ', gdata["TE"], ') / ', gdata["TDDE"], ')')
+ options(scipen=0)
+ }
+
+ if(vector == "Ae. aegypti"){
+ options(scipen=999)
+
+ tempK = '(temperature + 273.15)'
+
+ # feggfinal = ro * tempK * 24 * exp((0.0033557 - (1 / tempK))) / (1 + exp(deltaHH * (T_12H - 1 / tempK)))
+ # ( 3.57718120805369e-05 * (temperature + 273.15) * 24) * exp(0.0033557 - (1 / (temperature + 273.15))) / (1 + exp( 50327.1263210871 * ( 7.04994888787056e-05 - 1 / (temperature + 273.15))))
+ feggs <- paste('(',gdata["q1E"],' * ', tempK,' * ', gdata["q2E"],' ) * exp(',gdata["q4E"],' - (1 / ',tempK,')) / (1 + exp(',gdata["q5E"],' * (',gdata["q6E"],' - 1 / ',tempK,')))')
+ options(scipen=0)
+ }
+ return(feggs)
+}
diff --git a/R/filter_meteo.R b/R/filter_meteo.R
new file mode 100644
index 0000000000000000000000000000000000000000..4f79684b40b6ee9e128490566ea384c522add00a
--- /dev/null
+++ b/R/filter_meteo.R
@@ -0,0 +1,52 @@
+#' Filter Meteorological Data
+#'
+#' @description Filters meteorological data to retain only the rows corresponding to parcel IDs present in `parcels` and dates present in `TS_sim$time_serie_date`.
+#'
+#' @usage filter_meteo(parcels, meteo, TS_sim)
+#'
+#' @param parcels data.table with parcel information, including a column `ID` or `STATION`.
+#' @param meteo data.table with meteorological data, including columns `ID` and `DATE`.
+#' @param TS_sim list containing a vector `time_serie_date` of dates to be retained.
+#'
+#' @details
+#' This function ensures that the meteorological data contains only the IDs found in `parcels` and that there are records for all dates in `TS_sim$time_serie_date`.
+#'
+#' @return data.table with filtered meteorological data.
+#'
+#' @keywords filter meteo
+#'
+#' @examples
+#' # Example usage:
+#' parcels <- data.table(ID = 1:3, STATION = c('A', 'B', 'C'))
+#' meteo <- data.table(ID = c('A', 'B', 'C'), DATE = as.Date('2023-01-01') + 0:2)
+#' TS_sim <- list(time_serie_date = as.Date('2023-01-01') + 0:2)
+#' filter_meteo(parcels, meteo, TS_sim)
+#'
+#' @importFrom data.table data.table
+#'
+#' @export
+#'
+filter_meteo <- function(parcels, meteo, TS_sim) {
+ # Identifier la colonne contenant les identifiants
+ if ("STATION" %in% names(parcels)) {
+ parcels_ID <- parcels$STATION
+ } else {
+ parcels_ID <- parcels$ID
+ }
+
+ # Vérifier l'existence des identifiants dans meteo
+ if (!all(parcels_ID %in% meteo$ID)) {
+ stop("Certains identifiants dans 'parcels' n'existent pas dans 'meteo'")
+ }
+
+ # Créer une table avec toutes les combinaisons d'identifiants et de dates requises
+ required_combinations <- data.table(
+ ID = rep(parcels_ID, each = length(TS_sim$time_serie_date)),
+ DATE = rep(TS_sim$time_serie_date, times = length(parcels_ID))
+ )
+
+ # Filtrer les lignes de 'meteo' pour garder uniquement les combinaisons requises
+ meteo_filtered <- meteo[required_combinations, on = .(ID, DATE), nomatch = NULL]
+
+ return(meteo_filtered)
+}
diff --git a/R/flarvae.R b/R/flarvae.R
new file mode 100644
index 0000000000000000000000000000000000000000..eecbe6a4761d824cf4dd75d4149d797d34bbf66e
--- /dev/null
+++ b/R/flarvae.R
@@ -0,0 +1,27 @@
+#' Function for larvae development
+#'
+#' @description Function to write the temperature dependency for larvae development depending on the species
+#'
+#' @param vector string vector species
+#' @param gdata list of global data
+#'
+#' @return string
+#'
+#' @noRd
+
+flarvae <- function(vector, gdata){
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+ options(scipen=999)
+ flarvae <- paste0('(', gdata["q1L"], ' * temperature * temperature + ', gdata["q2L"], ' * temperature + ', gdata["q3L"], ')')
+ options(scipen=0)
+ }
+
+ if(vector == "Ae. aegypti"){
+ options(scipen=999)
+ tempK = '(temperature + 273.15)'
+ flarvae <- paste('((',gdata["q1L"],'*', tempK, ' * ',gdata["q2L"],') * exp(',gdata["q3L"],' * (',gdata["q4L"],' - 1 / ',tempK,')) / (1 + exp(',gdata["q5L"],' * (',gdata["q6L"],' - 1 / ',tempK,'))))')
+ options(scipen=0)
+ }
+
+ return(flarvae)
+}
diff --git a/R/fpupae.R b/R/fpupae.R
new file mode 100644
index 0000000000000000000000000000000000000000..3d8eaf70c95b7f60ae856c92acde7e0a79ad34a6
--- /dev/null
+++ b/R/fpupae.R
@@ -0,0 +1,27 @@
+#' Function for pupae development
+#'
+#' @description Function to write the temperature dependency for pupae development depending on the species
+#'
+#' @param vector string vector species
+#' @param gdata list of global data
+#'
+#' @return string
+#'
+#' @noRd
+
+fpupae <- function(vector, gdata){
+
+ if(vector %in% c("Ae. albopictus", "Ae. albopictus (D)")){
+ options(scipen=999)
+ fpupae <- paste0('(', gdata["q1P"], ' * temperature * temperature + ', gdata["q2P"], ' * temperature + ', gdata["q3P"], ')')
+ options(scipen=0)
+ }
+
+ if(vector == "Ae. aegypti"){
+ options(scipen=999)
+ tempK = '(temperature + 273.15)'
+ fpupae <- paste('((',gdata["q1P"],'*', tempK, ' * ',gdata["q2P"],') * exp(',gdata["q3P"],' * (',gdata["q4P"],' - 1 / ',tempK,')) / (1 + exp(',gdata["q5P"],' * (',gdata["q6P"],' - 1 / ',tempK,'))))')
+ options(scipen=0)
+ }
+ return(fpupae)
+}
diff --git a/R/globals.R b/R/globals.R
new file mode 100644
index 0000000000000000000000000000000000000000..e6b052081d85ef0211f1b4f2190b1648640c1029
--- /dev/null
+++ b/R/globals.R
@@ -0,0 +1,8 @@
+utils::globalVariables(c(".", ".N",
+ "start", "end", "action",
+ "id", "ID", "DATE",
+ "N", "POP", "RR", 'time','node',
+ "TP", "TP_PARCEL", "action",
+ "loc", "p",
+ 'CODE',
+ '0.25%', '50%' , '97.5%'))
diff --git a/R/iniState.R b/R/iniState.R
index 53c74754e5b9436a383681331177a133627d044f..20179855c85445aac7b530c64684d8d61f87ae8b 100644
--- a/R/iniState.R
+++ b/R/iniState.R
@@ -1,22 +1,41 @@
#' Write initial state of the meta-population
#'
#' @description initialize
-#' @usage iniState(PARCELLE)
+#' @usage iniState(parcels, diapause = FALSE, initMosq = 100000)
#'
-#' @param PARCELLE data.frame or data.table
+#' @param parcels data.frame or data.table
+#' @param diapause logical
#' @param initMosq numerical value Initial number of eggs in each node.
#'
-#' @return list
+#' @return list with two data.frame: u0 and v0
+#'
+#' u0 is the initial population stage for each compartment in each parcel. Each row describe a patch and in columns:
+#' "Sh": susceptible humans ; "Eh": exposed humans ; "Ih": infectious humans ;"Rh": recovered humans ;
+#' "A1gmE", "A1omE", "A2hmE", "A2gmE", "A2omE": exposed stages for adult mosquitoes (see details of stages below)
+#' "A1gmI" "A1omI" "A2hmI" "A2gmI" "A2omI": infectious stages for adult mosquitoes (see details of stages below)
+#' "Neggs": number of eggs layed by infected mosquitoes
+#' "ninfhL": number of local human autochtonous infection
+#' "ninfhE": number of external human autochtonous infection
+#' "ninfm1": number of nulliparous mosquitoes autochtonous infection
+#' "ninfm2": number of parous mosquitoes autochtonous infection
+#'
+#' v0 is the initial population and time-dependant parameters state. Each columns describe a patch and in rows:
+#' z: diapause (0 = dipause, 1 = favorable period); temperature; kL and kP: carrying capacities for larvae and pupae (rainfall dependent);
+#' Em: number of eggs ; Lm: number of larvae ; Pm: number of pupae ; Aemm: number of emerging adults ;
+#' A1hm: number of nulliparous adults seeking for host ; A1gm: number of gorged nulliparous adults ; A1om: number of nulliparous adults seeking for oviposition sites ;
+#' A2hm: number of parous adults seeking for host ; A2gm: number of gorged parous adults ; A1om: number of parous adults seeking for oviposition sites ;
+#' prevEggs, nIm1, nIm2, R0, betaHext and betaMext are continous variables calculated over time)
+#' newEggs: daily number of new layed eggs
#'
#' @keywords demography
#'
#' @export
-iniState <- function(PARCELLE, initMosq = 100000){
+iniState <- function(parcels, diapause = FALSE, initMosq = 100000){
- nh <- PARCELLE[, POP] %>% round
- nadm <- nrow(PARCELLE)
+ nh <- parcels[, POP] %>% round
+ nadm <- nrow(parcels)
u0 <- data.frame(
# Human
@@ -24,8 +43,18 @@ u0 <- data.frame(
Eh = rep(0, nadm),
Ih = rep(0, nadm),
Rh = rep(0, nadm),
+ # # diagnosed
+ # dEh = rep(0, nadm),
+ # dIh = rep(0, nadm),
+ # dRh = rep(0, nadm),
+
+ # Infected mosquitoes (non infected mosquitoes will be simulated into v0) - exposed (E) and infectious (I)
+ A1gmE = rep(0, nadm),
+ A1omE = rep(0, nadm),
+ A2hmE = rep(0, nadm),
+ A2gmE = rep(0, nadm),
+ A2omE = rep(0, nadm),
- # Infected mosquitoes (non infected mosquitoes will be simulated into v0)
A1gmI = rep(0, nadm),
A1omI = rep(0, nadm),
A2hmI = rep(0, nadm),
@@ -34,7 +63,9 @@ u0 <- data.frame(
Neggs = rep(0, nadm), #new eggs from infected mosquitoes
# Number of autochtonous human infection
- ninfh = rep(0, nadm),
+ # ninfh = rep(0, nadm),
+ ninfhL = rep(0, nadm),
+ ninfhE = rep(0, nadm),
ninfm1 = rep(0, nadm),
ninfm2 = rep(0, nadm)
)
@@ -48,23 +79,20 @@ u0 <- data.frame(
## First, make sure the variables are defined by creating v0.
## Inititialize them to zero.
-cont_var <- c(
- "z", "temperature", "kL", "kP",
- "Em", "Lm", "Pm",
- "Aemm", "A1hm", "A1gm", "A1om", "A2hm", "A2gm", "A2om",
- "prevEggs", "nIm1", "nIm2",
- "R0", "pIh", "pIm")
+cont_var <- list_compartments()$v0_compartments
v0 <- matrix(0,
nrow = length(cont_var),
- ncol = PARCELLE[, ID] %>% length,
+ ncol = parcels[, ID] %>% length,
dimnames=list(cont_var,
- unlist(PARCELLE[, ID])
+ unlist(parcels[, ID])
))
## Random initial mosquito population size (eggs)
v0["Em", ] <- initMosq # runif(nadm, 10000, 50000) %>% ceiling
+if(!diapause) v0["z", ] <- 1
+
return(list(u0 = u0,
v0 = v0))
}
diff --git a/R/list_compartments.R b/R/list_compartments.R
index 09f270f840bf5a522c02f2aee3389e173e44fa0e..803c74dca5caa4802213a54bee1f6e792b76c01e 100644
--- a/R/list_compartments.R
+++ b/R/list_compartments.R
@@ -1,46 +1,82 @@
-#' List compartments
+#' List compartments used in the model
#'
-#' @description function to list compartments
+#' @description This function lists the compartments used in the model, categorized into
+#' human and infected mosquito compartments (u0) and environmental and uninfected mosquito
+#' compartments (v0).
#'
#' @usage list_compartments()
#'
-#' @return u0 and v0 compartment as list
+#' @return A list with two elements:
+#' \describe{
+#' \item{u0_compartments}{A vector of compartment names related to human and infected mosquitoes.}
+#' \item{v0_compartments}{A vector of compartment names related to environmental variables and uninfected mosquitoes.}
+#' }
#'
#' @noRd
+#'
+#' @examples
+#' compartments <- list_compartments()
+#' print(compartments$u0_compartments)
+#' print(compartments$v0_compartments)
+#'
+list_compartments <- function() {
+ u0_compartments <- c(
+ # Human compartments
+ "Sh", # Susceptible humans
+ "Eh", # Exposed humans
+ "Ih", # Infectious humans
+ "Rh", # Recovered humans
-list_compartments <- function(){
-
-u0_compartments <- c(
- # Human
- "Sh",
- "Eh",
- "Ih",
- "Rh",
-
- # Infected mosquitoes (non infected mosquitoes will be simulated into v0)
- "A1gmI",
- "A1omI",
- "A2hmI",
- "A2gmI",
- "A2omI",
- "Neggs", #new eggs from infected mosquitoes
-
- # Number of autochtonous human infection
- "ninfh",
- "ninfm1",
- "ninfm2"
-)
-
+ # Infected mosquitoes (non-infected mosquitoes will be simulated into v0)
+ "A1gmE", # Nulliparous mosquitoes (gorged after blood meal)
+ "A1omE", # Nulliparous mosquitoes (seeking oviposition site)
+ "A2hmE", # Parous mosquitoes (seeking host)
+ "A2gmE", # Parous mosquitoes (gorged after blood meal)
+ "A2omE", # Parous mosquitoes (seeking oviposition site)
+ "A1gmI", # Nulliparous mosquitoes (gorged after blood meal, infected)
+ "A1omI", # Nulliparous mosquitoes (seeking oviposition site, infected)
+ "A2hmI", # Parous mosquitoes (seeking host, infected)
+ "A2gmI", # Parous mosquitoes (gorged after blood meal, infected)
+ "A2omI", # Parous mosquitoes (seeking oviposition site, infected)
+ "Neggs", # New eggs from infected mosquitoes
-v0_compartments <- c(
- "z", "temperature", "kL", "kP",
- "Em", "Lm", "Pm",
- "Aemm", "A1hm", "A1gm", "A1om", "A2hm", "A2gm", "A2om",
- "prevEggs", "nIm1", "nIm2",
- "R0", "pIh", "pIm")
+ # Number of autochthonous human infections
+ "ninfhL", # Number of infections in humans (latent)
+ "ninfhE", # Number of infections in humans (exposed)
+ "ninfm1", # Number of infections in mosquitoes (1st stage)
+ "ninfm2" # Number of infections in mosquitoes (2nd stage)
+ )
-return(list(u0_compartments = u0_compartments,
- v0_compartments = v0_compartments))
+ v0_compartments <- c(
+ "z", # Diapause (1 = Diapause, 0 = Favourable period for egg hatching)
+ "temperature",# Temperature variable
+ "RR_day", # Daily rainfall
+ "RR_7days", # Rainfall over the past 7 days
+ "kL", # Carrying capacity for larvae
+ "kP", # Carrying capacity for pupae
+ "Em", # Eggs
+ "Lm", # Larvae
+ "Pm", # Pupae
+ "Aemm", # Emerging adult mosquitoes
+ "A1hm", # Nulliparous mosquitoes seeking host
+ "A1gm", # Nulliparous mosquitoes gorged after blood meal
+ "A1om", # Nulliparous mosquitoes seeking oviposition site
+ "A2hm", # Parous mosquitoes seeking host
+ "A2gm", # Parous mosquitoes gorged after blood meal
+ "A2om", # Parous mosquitoes seeking oviposition site
+ "prevEggs", # Previous eggs count
+ "newEggs", # Daily new layed eggs
+ "nIm1", # Number of infections in mosquitoes (1st stage)
+ "nIm2", # Number of infections in mosquitoes (2nd stage)
+ "R0", # Basic reproduction number
+ "betaHext", # External transmission rate for humans
+ "betaMext", # External transmission rate for mosquitoes
+ "interv_Am", # Intervention parameters for adult mosquitoes
+ "E2I", # Transition from eggs to infectious mosquitoes
+ "G2O" # Growth transition to oviposition
+ )
+ return(list(u0_compartments = u0_compartments,
+ v0_compartments = v0_compartments))
}
diff --git a/R/pipe.R b/R/pipe.R
new file mode 100644
index 0000000000000000000000000000000000000000..7015dc5f39f149674e34fabeae0f4958896d38d7
--- /dev/null
+++ b/R/pipe.R
@@ -0,0 +1,4 @@
+#' @importFrom magrittr %>% %<>%
+#' @export
+magrittr::`%>%`
+magrittr::`%<>%`
diff --git a/R/plot_TS.R b/R/plot_TS.R
new file mode 100644
index 0000000000000000000000000000000000000000..84a3fff5c5a0681fe907084bdad068f256f0bd41
--- /dev/null
+++ b/R/plot_TS.R
@@ -0,0 +1,96 @@
+#' Plot trajectories of the first simulation
+#'
+#' @description Function used to plot the trajectories of any compartments (median and 95% interval over all the selected parcels and simulation).
+#'
+#' @param traj output of a run_arbocartoR simulation
+#' @param stage String vector. Epidemiological or biological stages to visualize (see colnames of traj).
+#' @param parcels_ids String vector. Patch ids to visualize (must match with ID column in traj objects).
+#' @param simulation Numerical vector. Considered simulation (must be <= to the length of traj).
+#'
+#' @importFrom dygraphs dygraph dySeries
+#' @importFrom stats quantile
+#' @importFrom data.table setnames
+#'
+#' @return dygraphs plot
+#'
+#' @keywords plot trajectories visualization
+#'
+#' @examples
+#'
+#' \dontrun{
+#' data(parcels)
+#' data(meteo)
+#'
+#' parcels <- parcels[startsWith(ID, "06"),]
+#'
+#' traj <- run_arbocartoR(parcels = parcels,
+#' vector = "Ae. albopictus",
+#' virus = "DEN",
+#' meteo = meteo)
+#'
+#' plot_TS(traj, stage = c("Em", "Lm", "Pm"), parcels_ids = NULL, simulation = 1)
+#' }
+#'
+#' @export
+
+plot_TS <- function(traj,
+ stage,
+ parcels_ids = NULL,
+ simulation = 1) {
+
+ # Input validation
+ if (any(!stage %in% names(traj[[1]]))) {
+ stop("Stages must be columns in the trajectories from the traj list")
+ }
+
+ if (is.null(parcels_ids)) {
+ parcels_ids <- unique(traj[[1]][, ID])
+ } else if (any(!parcels_ids %in% traj[[1]][, ID])) {
+ stop("Selected parcels_ids must be present in the ID columns of trajectories")
+ }
+
+ if (length(simulation) > length(traj) || any(simulation > length(traj))) {
+ stop(paste("There are only", length(traj), "simulations in your traj object"))
+ }
+
+ # Combine data from selected simulations
+ if (length(simulation) > 1) {
+ data_select <- do.call(rbind, traj[simulation])
+ } else {
+ data_select <- traj[[simulation]]
+ }
+
+ # Filter data by parcels_ids
+ data_select <- data_select[ID %in% parcels_ids, ]
+
+ data2plot <- NULL
+
+ for (stage2plot in stage) {
+ # Compute quantiles for each stage
+ dataOFstage <- data_select[, .(
+ `0.25%` = quantile(get(stage2plot), 0.025),
+ `50%` = quantile(get(stage2plot), 0.5),
+ `97.5%` = quantile(get(stage2plot), 0.975)
+ ), by = DATE]
+
+ # Rename columns
+ setnames(dataOFstage, c("0.25%", "50%", "97.5%"),
+ c(paste("0.25%", stage2plot), stage2plot, paste("97.5%", stage2plot)))
+
+ # Merge data for plotting
+ if (is.null(data2plot)) {
+ data2plot <- dataOFstage
+ } else {
+ data2plot <- merge(data2plot, dataOFstage, by = "DATE")
+ }
+ }
+
+ # Create dygraph plot
+ p <- dygraph(data2plot)
+
+ for (stage2plot in stage) {
+ p <- dySeries(p, c(paste("0.25%", stage2plot), stage2plot, paste("97.5%", stage2plot)))
+ }
+
+ p
+}
diff --git a/R/runArboRisk.R b/R/runArboRisk.R
deleted file mode 100644
index 95ae9b4b91cf21cf4366d2b2219a0c7b6cab585d..0000000000000000000000000000000000000000
--- a/R/runArboRisk.R
+++ /dev/null
@@ -1,301 +0,0 @@
-#' Run a simulation
-#'
-#' @description function to run simulations
-#'
-#' @usage runArboRisk(PARCELLE, METEO, gdata, mMov = NULL, start_date, end_date, nYR_init = 2, nodeID = "ID")
-#'
-#' @param PARCELLE data.frame or data.table
-#' @param METEO data.frame or data.table
-#' @param gdata list
-#' @param vector_species string
-#' @param mMov double matrix
-#' @param start_date date in '\%Y-\%m-\%d' format
-#' @param end_date date in '\%Y-\%m-\%d' format
-#' @param nYR_init numeric. Number of years used to initialize the population dynamics (default is 1)
-#' @param n_sim integer
-#' @param introduction_pts data.frame or data.table
-#' @param u0 matrix Initial population state (patches as columns and in rows: Sh, Eh, Ih, Rh, A1gmI, A1omI, A2hmI, A2gmI, A2omI, Neggs, ninfh, ninfm1, ninfm2)
-#' @param v0 matrix Initial population and time-dependant parameters state (patches as rows and in columns:
-#' z: diapause (0 = dipause, 1 = favorable period); temperature; kL and kP: carrying capacities for larvae and pupae (rainfall dependent);
-#' Em: number of eggs ; Lm: number of larvae ; Pm: number of pupae ; Aemm: number of emerging adults ;
-#' A1hm: number of nulliparous adults seeking for host ; A1gm: number of gorged nulliparous adults ; A1om: number of nulliparous adults seeking for oviposition sites ;
-#' A2hm: number of parous adults seeking for host ; A2gm: number of gorged parous adults ; A1om: number of parous adults seeking for oviposition sites ;
-#' prevEggs, nIm1, nIm2, R0, pIh and pIm are continous variables calculated over time)
-#' @param initMosq numeric. Number of eggs in each patch at t0 (default is 100000).
-#'
-#'
-#' @importFrom SimInf mparse
-#' @importFrom SimInf run
-#' @importFrom SimInf trajectory
-#' @importFrom pbapply pblapply
-#' @importFrom magrittr is_greater_than
-#'
-#' @return data.table
-#'
-#' @export
-
-
-runArboRisk <- function(PARCELLE,
-
- vector_species = "Ae. albopictus",
- climate = "temperate",
- gdata = NULL,
-
- ldata = NULL,
-
- METEO = NULL,
- mMov = NULL,
-
- start_date = NULL,
- end_date = NULL,
- nYR_init = 1,
- n_sim = 1,
- introduction_pts = NULL,
-
- u0 = NULL,
- v0 = NULL,
- initMosq = 100000){
-
- if(is.null(ldata) & is.null(METEO)) stop("you must provide either ldata matrix or meteorological dataset (METEO)")
-
- if(!is.null(ldata) & !is.null(mMov)) stop("you can not provide a new human contact matrix if you provide ldata. Please generate a new ldata with the current mMov and set mMov to NULL")
-
- if((is.null(start_date) | is.null(end_date)) & is.null(METEO)) stop("if the meteorological dataset (METEO) is not provided, you must provide start en end dates for simulations (arguments: start_date, end_date)")
-
- if(n_sim < 1)
- stop('The number of simulations must be positive a positive integer')
-
- ####################
- ### General data ###
- ####################
- # input data:
- # PARCELLE : table where each row is a node and columns are attributes
- # METEO: table with four columns nodeID, date, daily rainfall, daily mean temperature
-
- check_PARCELLE(PARCELLE)
-
- ############################
- ### Model initialization ###
- ############################
-
- if(is.null(start_date))
- start_date <- min(METEO$DATE)
-
- if(is.null(end_date))
- end_date <- max(METEO$DATE)
-
- if(!is.null(METEO))
- if(start_date < min(METEO$DATE) | end_date > max(METEO$DATE))
- stop("start_date and end_date must be included in meteorological records")
-
- ## Simulation period ##
- TS_sim <- sim_time_serie(start_date, end_date, nYR_init)
-
- ###########################################
- ## Create u0, v0 and compartment objects ##
- ###########################################
-
- message("## Initialization ##")
-
- init <- iniState(PARCELLE, initMosq = initMosq)
-
- if(is.null(u0))
- u0 <- init$u0
- if(is.null(v0))
- v0 <- init$v0
-
- ###############################################################
- ## Define the compartments, gdata and stochastic transitions ##
- ###############################################################
- ## Stochastic transitions are related to the epidemiological model and the life cycle of infected mosquitoes.
-
- #### Global data (general parameters) ####
-
- gdata <- check_gdata(gdata, vector_species, climate)
-
- ##################
- ## Define ldata ##
- ##################
- ## ldata is a vector of local data: daily temperature, kL and kP and number of non infected mosquitoes in each stage.
- ## the first item (index = 0) is the number of simulated days, it will be used to daily update v0 with ldata content.
- ## Now improve this and use time to index data in ldata (local data).
-
-
- if(is.null(ldata)){
- message("## Format local data ##")
- ldata <- build_ldata(PARCELLE,
- METEO,
- gdata,
- vector_species,
- climate,
- mMov,
- start_date,
- end_date,
- nYR_init)
- } else {
- if(ldata[1,1] != length(TS_sim$time_serie_date))
- stop(paste0("The number of days considered in ldata (",ldata[1,1],") is not consistent with the simulated period and the number of initialization years (",length(TS_sim$time_serie_date)," days)."))
-
- if(ncol(ldata) != nrow(PARCELLE))
- stop(paste0("The number of patch considered in ldata (",ncol(ldata),") is not consistent with the number of patchs in PARCELLE (",nrow(PARCELLE),")."))
- }
-
- ##############
- ## Diapause ##
- ##############
-
- # Calculates days for diapause over all the simulated period and build pts_fun
- if( !is.null(gdata$startFav) & !is.null(gdata$endFav)){
- diapause_interv <- diapause(startFav = gdata$startFav,
- endFav = gdata$endFav,
- TS_sim = TS_sim)
- }
-
- gdata %<>% .[-which(names(gdata) %in% c("startFav","endFav"))]
- gdata %<>% unlist
- mode(gdata) <- "numeric"
-
-
- message("## Build stochastic transitions ##")
- #### Stochastic transitions ####
- stoch_transitions <- build_transitions(gdata)
-
- ###########################################################
- ### Deterministic transitions for mosquitoes life cycle ###
- ###########################################################
- # pts_fun is a post time step function in C_code updating v0 at each time step.
- # It is used for meterological and evironemental data, diapause trigger and
- # vector population stages driven by deterministic events.
-
- pts_fun <- build_pts_fun(u0, v0, gdata, ldata, diapause_interv)
-
- ###################
- ### Simulations ###
- ###################
-
- # u0[1, 2] <- 1000
- # u0[, 7] <- 1000
-
- # start_time <- Sys.time()
-
- message("## Build the model ##")
- # message(Sys.time())
-
- if(is.null(introduction_pts)){
-
- model <- mparse(
- transitions = stoch_transitions,
- compartments = u0 %>% colnames,
- gdata = gdata,
- ldata = ldata,
- u0 = u0,
- v0 = v0,
- tspan = TS_sim$time_serie_num, # number of days simulated. Start at 0 to get the indexing correct in the post-time-step function.
- pts_fun = pts_fun
- )
-
- } else {
-
- ###########################################
- ### Introduction of exposed individuals ###
- ###########################################
-
- # E Matrix for the select process
- E <- structure(.Data = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #1
- 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #2
- 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #3
- 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, #4
- 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, #5
- 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0 #6
- ),
- .Dim = c(length(u0 %>% colnames),6),
- .Dimnames = list(u0 %>% colnames,
- c("1", "2", "3", "4", "5", "6"))
- )
-
- # N matrix for the shift process
- N <- matrix(rep(0, length(u0 %>% colnames)), nrow = length(u0 %>% colnames), ncol = 2,
- dimnames = list(u0 %>% colnames,
- c("1", "2")))
-
- # turn dates of introduction_pts into time points
-
- if(FALSE %in% (introduction_pts$time %in% seq.Date(from = start_date, to = end_date, by ="day")))
- warning(paste0("At least one introduction occurs outside the simulation period _n", capture.output(introduction_pts[!introduction_pts$time %in% seq.Date(from = start_date, to = end_date, by ="day") ]), collapse = "\n"))
-
- introduction_pts$time %<>% match(., TS_sim$time_serie_date)
-
- # turn IDs into numerical IDs
- introduction_pts$node <- introduction_pts$dest %<>% match(., PARCELLE$ID)
-
- # select the stage
- introduction_pts$select %<>% match(., u0 %>% colnames)
-
- introduction_pts$event = "enter" ## Event "extTrans" is a movement between nodes
- introduction_pts$dest = 0 ## Which node is the destination node
- introduction_pts$proportion = 0 ## This is not used when n > 0
- introduction_pts$shift = 0 ## Not used in this example
-
- if(introduction_pts %>% is.na %>% sum %>% is_greater_than(0))
- stop("introduction_pts format is not respected. \n
- ids in 'node' columns must be in PARCELLE ID. \n
- Dates in 'time' must be included in the simulated period. \n
- Epidemiological stages in 'select' must be among the following stages: 'Sh', 'Eh', 'Ih', 'Rh', 'A1gmI', 'A1omI', 'A2hmI', 'A2gmI', 'A2omI'.")
-
- model <- mparse(
- transitions = stoch_transitions,
- compartments = u0 %>% colnames,
- gdata = gdata,
- ldata = ldata,
- u0 = u0,
- v0 = v0,
- tspan = TS_sim$time_serie_num, # number of days simulated. Start at 0 to get the indexing correct in the post-time-step function.
- pts_fun = pts_fun,
- # introduction of exposed individuals
- events = introduction_pts,
- E = E,
- N = N
- )
-
- }
-
-
- message("## Run simulations ##")
- output <- pblapply(1:n_sim, function(x){
- traj <- model %>% run %>% trajectory
- setDT(traj)
- traj[, DATE := TS_sim$time_serie_date, by = node]
-
- traj %<>% .[DATE %in% TS_sim$time_serie_output_d]
- traj[,time := TS_sim$time_serie_output_t, by = node]
-
- traj[, ID := PARCELLE$ID[node]]
-
- setcolorder(traj, c("ID", "node",
- "DATE", "time",
- "Sh", "Eh", "Ih", "Rh",
- "Em", "Lm", "Pm", "Aemm", "A1hm", "A1gm", "A1om", "A2hm", "A2gm", "A2om", "A1gmI", "A1omI", "A2hmI", "A2gmI", "A2omI",
- "R0", "ninfh", "ninfm1", "ninfm2",
- "z", "temperature", "kL", "kP"))
-
- traj[, `:=`(Neggs = NULL,
- prevEggs = NULL,
- nIm1 = NULL,
- nIm2 = NULL,
- pIh = NULL,
- pIm = NULL
- )]
-
- if(is.null(introduction_pts)){
- traj[, `:=`(ninfh = NULL,
- ninfm1 = NULL,
- ninfm2 = NULL
- )]
- }
-
- traj
-
- })
-
- return(output)
-}
diff --git a/R/run_arbocartoR.R b/R/run_arbocartoR.R
new file mode 100644
index 0000000000000000000000000000000000000000..56c2c70ca9fe4f4e4378e031bf5e33d2a58d7b4e
--- /dev/null
+++ b/R/run_arbocartoR.R
@@ -0,0 +1,292 @@
+#' Run a simulation
+#'
+#' @description function to run simulations
+#'
+#' @param parcels data.frame or data.table describing the patches. Required columns: 'ID': unique identifier, 'POP': population size, 'Kfix': fix carrying capacity for larvae and pupae, 'Kvar': variable carrying capacity for larvae and pupae, 'STATION': meteorological station identifier (optional), 'DIFF_ALT': difference between meteorological station altitude and average altitude of the patch (optional).
+#' @param vector string. "Ae. albopictus", "Ae. albopictus (D)" or "Ae. aegypti". Default is "Ae. albopictus".
+#' @param virus string. "DEN" (dengue), "ZIK" (zika) or "CHI" (chikungunya). Default is "DEN" (dengue) virus.
+#' @param gdata list of parameters. Can be generated using `build_gdata` function.
+#' @param ldata matrix of local data
+#' @param meteo data.frame or data.table reporting the daily meteorological data for each meteorological station. Required columns: 'ID', 'DATE', 'RR': daily precipitation (mm), 'TP': daily mean temperature (degrees)
+#' @param mMov double matrix
+#' @param start_date date in '\%Y-\%m-\%d' format
+#' @param end_date date in '\%Y-\%m-\%d' format
+#' @param nYR_init numeric. Number of years used to initialize the population dynamics (default is 1)
+#' @param n_sim integer
+#' @param introduction_pts data.frame or data.table describing the introduction of individuals. Can be generated by [build_E_random()] function (see function documentation for additional details on the structure.
+#' @param prev_control data.frame or data.table describing preventive control measure implemented. Required columns: 'action', 'loc', 'start', 'end', 'p' (see details)
+#' @param u0 data.frame describing the initial population stage for each compartment in each parcel. Can be generated by [iniState()] function (see documentation of the function for more details on the structure).
+#' @param v0 data.frame describing the initial population and time-dependant parameters state. Can be generated by [iniState()] function (see documentation of the function for more details on the structure).
+#'
+#' @param verbose logical. Provide additional information during process
+#'
+#' @param initMosq numeric. Number of eggs in each patch at t0 (default is 100000).
+#'
+#' @details
+#' Preventive control content:
+#' 'action' column must be strings 'K', 'L' or 'A'. 'K': Source reduction (removal or destruction of breeding sites); 'L': Chemical Larviciding; 'A': Fogging or Area Spraying (targets adult mosquitoes)
+#' 'loc' column must be a parcel id
+#' 'start' is the first day of implementation of the measure
+#' 'end' is the last day of implementation of the measure (the control is implemented every day in between)
+#' 'p' must be a number between 0 and 1. It is for the "K" action: the proportion of sites daily removed during the action ; for the "A" action: the additional daily mortality of adults due to action and for the "L" action: the additional daily mortality of larvae due to larvicide
+#'
+#'
+#' @importFrom SimInf mparse run trajectory
+#' @importFrom magrittr is_greater_than
+#' @importFrom data.table `:=` setDT setcolorder
+#' @importFrom utils capture.output
+#'
+#' @return data.table
+#'
+#' @export
+
+
+run_arbocartoR <- function(parcels,
+
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ gdata = NULL,
+
+ ldata = NULL,
+
+ meteo = NULL,
+ mMov = NULL,
+
+ start_date = NULL,
+ end_date = NULL,
+ nYR_init = 1,
+ n_sim = 1,
+ introduction_pts = NULL,
+ prev_control = NULL,
+
+ u0 = NULL,
+ v0 = NULL,
+ initMosq = 100000,
+ verbose = F){
+
+ if(is.null(ldata) & is.null(meteo))
+ stop("you must provide either ldata matrix or meteorological dataset (meteo)")
+
+ if(!is.null(ldata) & !is.null(mMov))
+ stop("you can not provide a new human contact matrix if you provide ldata. Please generate a new ldata with the current mMov and set mMov to NULL")
+
+ if((is.null(start_date) | is.null(end_date)) & is.null(meteo))
+ stop("if the meteorological dataset (meteo) is not provided, you must provide start en end dates for simulations (arguments: start_date, end_date)")
+
+ if(n_sim < 1)
+ stop('The number of simulations must be positive a positive integer')
+
+ ####################
+ ### General data ###
+ ####################
+ # input data:
+ # parcels : table where each row is a node and columns are attributes
+ # meteo: table with four columns nodeID, date, daily rainfall, daily mean temperature
+
+ check_parcels(parcels)
+
+ ############################
+ ### Model initialization ###
+ ############################
+
+ if(is.null(start_date))
+ start_date <- min(meteo$DATE) %>% as.Date
+
+ if(is.null(end_date))
+ end_date <- max(meteo$DATE) %>% as.Date
+
+ if(!is.null(meteo))
+ if(start_date < min(meteo$DATE) | end_date > max(meteo$DATE))
+ stop("start_date and end_date must be included in meteorological records")
+
+ ## Simulation period ##
+ TS_sim <- sim_time_serie(start_date, end_date, nYR_init)
+
+ # Check and filter meteo
+
+ if(!is.null(meteo))
+ meteo <- filter_meteo(parcels, meteo, TS_sim)
+
+ # preventive prev_control check
+ if(!is.null(prev_control))
+ check_prev_control(prev_control, TS_sim$time_serie_output_d)
+
+ ###########################################
+ ## Create u0, v0 and compartment objects ##
+ ###########################################
+
+ if(verbose)
+ message("## Initialization ##")
+
+ init <- iniState(parcels,
+ diapause = (vector == "Ae. albopictus (D)"),
+ initMosq = initMosq)
+
+ if(! is.null(u0) | !is.null(v0)){
+ nYR_init = 0
+ cat("as u0 and/or v0 is not null, the model is not initialized and start from the predefined population state")
+ }
+ if(is.null(u0))
+ u0 <- init$u0
+ if(is.null(v0))
+ v0 <- init$v0
+
+
+ ###############################################################
+ ## Define the compartments, gdata and stochastic transitions ##
+ ###############################################################
+ ## Stochastic transitions are related to the epidemiological model and the life cycle of infected mosquitoes.
+
+ #### Global data (general parameters) ####
+
+ gdata <- check_gdata(gdata, vector, virus)
+
+ ##################
+ ## Define ldata ##
+ ##################
+ ## ldata is a vector of local data: daily temperature, kL and kP and number of non infected mosquitoes in each stage.
+ ## the first item (index = 0) is the number of simulated days, it will be used to daily update v0 with ldata content.
+ ## Now improve this and use time to index data in ldata (local data).
+
+ if(is.null(ldata)){
+ if(verbose)
+ message("## Format local data ##")
+ ldata <- build_ldata(parcels = parcels,
+ meteo = meteo,
+ gdata = gdata,
+ vector = vector,
+ virus = virus,
+ mMov = mMov,
+ prev_control = prev_control,
+ start_date = start_date,
+ end_date = end_date,
+ nYR_init = nYR_init)
+ } else {
+ if(ldata[1,1] != length(TS_sim$time_serie_date))
+ stop(paste0("The number of days considered in ldata (",ldata[1,1],") is not consistent with the simulated period and the number of initialization years (",length(TS_sim$time_serie_date)," days)."))
+
+ if(ncol(ldata) != nrow(parcels))
+ stop(paste0("The number of patch considered in ldata (",ncol(ldata),") is not consistent with the number of patchs in parcels (",nrow(parcels),")."))
+ }
+
+ ##############
+ ## Diapause ##
+ ##############
+
+ # Calculates days for diapause over all the simulated period and build pts_fun
+ if( !is.null(gdata$startFav) & !is.null(gdata$endFav)){
+ diapause_interv <- diapause(startFav = gdata$startFav,
+ endFav = gdata$endFav,
+ TS_sim = TS_sim)
+ } else diapause_interv <- NULL
+
+ gdata %<>% .[which(!names(gdata) %in% c("startFav","endFav"))] %>% unlist
+ mode(gdata) <- "numeric"
+
+ if(verbose)
+ message("## Build stochastic transitions ##")
+ #### Stochastic transitions ####
+ stoch_transitions <- build_transitions(gdata)
+
+ ###########################################################
+ ### Deterministic transitions for mosquitoes life cycle ###
+ ###########################################################
+ # pts_fun is a post time step function in C_code updating v0 at each time step.
+ # It is used for meterological and evironemental data, diapause trigger and
+ # vector population stages driven by deterministic events.
+
+ pts_fun <- build_pts_fun(u0,
+ v0,
+ gdata,
+ ldata,
+ vector,
+ virus,
+ diapause_interv,
+ TS_sim,
+ prev_control)
+
+ gc()
+
+ ###################
+ ### Simulations ###
+ ###################
+
+ # u0[1, 2] <- 1000
+ # u0[, 7] <- 1000
+
+ # start_time <- Sys.time()
+
+ if(verbose)
+ message("## Build the model ##")
+ # message(Sys.time())
+
+ if(is.null(introduction_pts)){
+
+ model <- mparse(
+ transitions = stoch_transitions,
+ compartments = u0 %>% colnames,
+ gdata = gdata,
+ ldata = ldata,
+ u0 = u0,
+ v0 = v0,
+ tspan = TS_sim$time_serie_num, # number of days simulated. Start at 0 to get the indexing correct in the post-time-step function.
+ pts_fun = pts_fun
+ )
+
+ if(verbose)
+ message("## Run simulations ##")
+ output <- runsimulations(model, n_sim, TS_sim, parcels, introduction_pts)
+
+ } else {
+
+ ###########################################
+ ### Introduction of exposed individuals ###
+ ###########################################
+
+ # E Matrix for the select process
+ E <- structure(.Data = c(names(u0) == "Sh", #1 Human host - susceptible
+ names(u0) == "Eh", #2 Human host - exposed
+ names(u0) == "Ih", #3 Human host - infected
+ names(u0) == "Rh", #4 Human host - recovered
+ names(u0) %in% c("Sh", 'Eh', "Ih", "Rh"), #5 Human host - anyone
+ startsWith(names(u0), "A1h") | startsWith(names(u0), "A1o") | startsWith(names(u0), "A2h") | startsWith(names(u0), "A2o"), #6 Mosquito vector - any exposed or infected adult
+ startsWith(names(u0), "A") #7 Mosquito vector - any exposed or infected adult
+ ) %>% as.numeric,
+ .Dim = c(length(u0 %>% colnames), 7),
+ .Dimnames = list(u0 %>% colnames,
+ c("1", "2", "3", "4", "5", "6","7"))
+ )
+
+ # N matrix for the shift process
+ N <- matrix(rep(0, length(u0 %>% colnames)),
+ nrow = length(u0 %>% colnames), ncol = 2,
+ dimnames = list(u0 %>% colnames,
+ c("1", "2")))
+
+ model <- mparse(
+ transitions = stoch_transitions,
+ compartments = u0 %>% colnames,
+ gdata = gdata,
+ ldata = ldata,
+ u0 = u0,
+ v0 = v0,
+ tspan = TS_sim$time_serie_num, # number of days simulated. Start at 0 to get the indexing correct in the post-time-step function.
+ pts_fun = pts_fun,
+ # introduction of exposed individuals
+ events = set_introduction_pts(introduction_pts, start_date, end_date, TS_sim, parcels, u0),
+ E = E,
+ N = N
+ )
+
+
+ if(verbose)
+ message("## Run simulations ##")
+ output <- runsimulations(model, n_sim, TS_sim, parcels, introduction_pts)
+
+ }
+
+ gc()
+
+
+ return(output)
+}
diff --git a/R/runsimulations.R b/R/runsimulations.R
new file mode 100644
index 0000000000000000000000000000000000000000..60a3381c77a6ce992b4f924fe770d280b3089c6f
--- /dev/null
+++ b/R/runsimulations.R
@@ -0,0 +1,88 @@
+#' Run simulations and produce the output
+#'
+#' @description This function runs simulations and produces output.
+#'
+#' @param model siminf model
+#' @param n_sim Integer. Number of simulations.
+#' @param TS_sim List. Four vectors of simulated dates (dates) and simulated days (numeric) with and without the initialization period.
+#' @param parcels data.frame or data.table describing the patches. Required columns: 'ID': unique identifier, 'POP': population size, 'Kfix': fix carrying capacity for larvae and pupae, 'Kvar': variable carrying capacity for larvae and pupae, 'STATION': meteorological station identifier (optional), 'DIFF_ALT': difference between meteorological station altitude and average altitude of the patch (optional).
+#' @param introduction_pts data.frame or data.table describing the introduction of individuals. Can be generated by [build_E_random()] function (see function documentation for additional details on the structure).
+#'
+#' @importFrom pbapply pblapply
+#' @importFrom SimInf run trajectory
+#' @importFrom shiny isRunning incProgress withProgress
+#' @importFrom data.table data.table setattr as.data.table .SD
+#'
+#' @noRd
+
+runsimulations <- function(model, n_sim, TS_sim, parcels, introduction_pts) {
+
+ # Helper function to process a single simulation
+ process_simulation <- function(x) {
+ traj <- as.data.table(trajectory(run(model)))
+ traj[, DATE := TS_sim$time_serie_date[time + 1], by = node]
+ traj[, ID := parcels$ID[.SD$node]]
+ traj <- traj[DATE %in% TS_sim$time_serie_output_d]
+
+ if (!is.null(introduction_pts)) {
+ cols <- c("ID", "DATE", "time", "Sh", "Eh", "newEggs", "Ih", "Rh", "Em", "Lm", "Pm", "Aemm",
+ "A1hm", "A1gm", "A1om", "A2hm", "A2gm", "A2om", "A1gmE", "A1omE", "A2hmE",
+ "A2gmE", "A2omE", "A1gmI", "A1omI", "A2hmI", "A2gmI", "A2omI", "R0",
+ "ninfhL", "ninfhE", "ninfm1", "ninfm2", "interv_Am", "z", "temperature",
+ "RR_day", "RR_7days", "kL", "kP", "E2I", "G2O")
+ } else {
+ cols <- c("ID", "DATE", "time", "Sh", "Em", "newEggs", "Lm", "Pm", "Aemm", "A1hm", "A1gm",
+ "A1om", "A2hm", "A2gm", "A2om", "R0", "interv_Am", "z", "temperature",
+ "RR_day", "RR_7days", "kL", "kP")
+ }
+
+ setcolorder(traj, cols)
+ traj[, cols, with = FALSE]
+ }
+
+ if (shiny::isRunning() & n_sim > 1) {
+ percentage <- 0
+ output <- withProgress(message = "Simulations progress: ", value = 0, {
+ pblapply(1:n_sim, function(x) {
+ traj <- process_simulation(x)
+ percentage <<- percentage + 1 / n_sim * 100
+ incProgress(1 / n_sim, detail = paste(round(percentage), "%"))
+ gc()
+ traj
+ })
+ })
+ } else {
+ output <- pblapply(1:n_sim, function(x) {
+ traj <- process_simulation(x)
+ gc()
+ traj
+ })
+ }
+
+ # Setting attributes
+ setattr(output, "ID", "identifier of the spatial unit")
+ setattr(output, "DATE", "simulated day")
+ setattr(output, "time", "simulated time step")
+
+ setattr(output, "Sh", "number of susceptible humans")
+ setattr(output, "Eh", "number of exposed humans")
+ setattr(output, "Ih", "number of infectious humans")
+ setattr(output, "Rh", "number of recovered humans")
+ setattr(output, "Em", "number of mosquito eggs")
+ setattr(output, "Lm", "number of mosquito larvae")
+ setattr(output, "Pm", "number of mosquito pupae")
+ setattr(output, "Aemm", "emerging adult mosquitoes")
+ setattr(output, "A1hm", "nulliparous adult mosquitoes seeking for host")
+ setattr(output, "A1gm", "nulliparous adult mosquitoes gorged after blood meal")
+ setattr(output, "A1om", "nulliparous adult mosquitoes seeking for oviposition site")
+ setattr(output, "A2hm", "parous adult mosquitoes seeking for host")
+ setattr(output, "A2gm", "parous adult mosquitoes gorged after blood meal")
+ setattr(output, "A2om", "parous adult mosquitoes seeking for oviposition site")
+
+ setattr(output, "R0", "basic reproduction number")
+ setattr(output, "interv_Am", "additional death rate for adults due to control interventions")
+ setattr(output, "z", "diapause (1 = Diapause, 0 = Favourable period for egg hatching)")
+
+ gc()
+ return(output)
+}
diff --git a/R/set_introduction_pts.R b/R/set_introduction_pts.R
new file mode 100644
index 0000000000000000000000000000000000000000..01730c5ba3311fdb510e340dc9f26f4491386d1e
--- /dev/null
+++ b/R/set_introduction_pts.R
@@ -0,0 +1,54 @@
+#' Set introduction point to the right format for SimInf
+#'
+#' @description This is an internal function to turn introduction_pts into a format that fits SimInf input.
+#'
+#' @param introduction_pts data.frame or data.table describing the introduction of individuals. Can be generated by [build_E_random()] function (see function documentation for additional details on the structure).
+#' @param start_date Date in 'YYYY-MM-DD' format.
+#' @param end_date Date in 'YYYY-MM-DD' format.
+#' @param TS_sim List. Four vectors of simulated dates (dates) and simulated days (numeric) with and without the initialization period.
+#' @param parcels data.frame or data.table describing the patches. Required columns: 'ID': unique identifier, 'POP': population size, 'Kfix': fix carrying capacity for larvae and pupae, 'Kvar': variable carrying capacity for larvae and pupae, 'STATION': meteorological station identifier (optional), 'DIFF_ALT': difference between meteorological station altitude and average altitude of the patch (optional).
+#' @param u0 data.frame describing the initial population stage for each compartment in each parcel. Can be generated by [iniState()] function (see documentation of the function for more details on the structure).
+#'
+#' @return The modified introduction_pts data.frame or data.table.
+#'
+#' @noRd
+
+set_introduction_pts <- function(introduction_pts, start_date, end_date, TS_sim, parcels, u0) {
+
+ # Ensure dates are in Date format
+ start_date <- as.Date(start_date)
+ end_date <- as.Date(end_date)
+
+ # Validate introduction dates
+ if (any(!introduction_pts$time %in% seq.Date(from = start_date, to = end_date, by = "day"))) {
+ warning(paste0(
+ "At least one introduction occurs outside the simulation period:\n",
+ paste(introduction_pts[!introduction_pts$time %in% seq.Date(from = start_date, to = end_date, by = "day")], collapse = "\n")
+ ))
+ }
+
+ # Convert introduction times to simulation time points
+ introduction_pts$time <- match(introduction_pts$time, TS_sim$time_serie_date) - 1
+
+ # Convert destination IDs to numerical IDs
+ introduction_pts$node <- match(introduction_pts$dest, parcels$ID)
+
+ # Select the stage
+ introduction_pts$select <- match(introduction_pts$select, colnames(u0))
+
+ # Add event details
+ introduction_pts$event <- "enter"
+ introduction_pts$dest <- 0
+ introduction_pts$proportion <- 0
+ introduction_pts$shift <- 0
+
+ # Check for NA values and stop if found
+ if (any(is.na(introduction_pts))) {
+ stop("introduction_pts format is not respected.\n",
+ "IDs in 'node' columns must be in parcels ID.\n",
+ "Dates in 'time' must be included in the simulated period.\n",
+ "Epidemiological stages in 'select' must be among the following stages: 'Sh', 'Eh', 'Ih', 'Rh', 'A1gmI', 'A1omI', 'A2hmI', 'A2gmI', 'A2omI'.")
+ }
+
+ return(introduction_pts)
+}
diff --git a/R/sim_time_serie.R b/R/sim_time_serie.R
index 3a80979cfa98a6f4acfe96f7024bf9acd2ffc620..b7ca8d7bd34e69b9e423c9318eec371178e5f8e0 100644
--- a/R/sim_time_serie.R
+++ b/R/sim_time_serie.R
@@ -1,6 +1,6 @@
-#' Time serie of the simulated periods
+#' Time series of the simulated periods
#'
-#' @description Function to calculates the dates and time points for simulations
+#' @description Function to calculate the dates and time points for simulations.
#'
#' @usage sim_time_serie(start_date, end_date, nYR_init)
#'
@@ -8,35 +8,35 @@
#' @param end_date Date. Last day of output desired.
#' @param nYR_init Numerical value. Number of years for initialization of the dynamics.
#'
-#' @return list with dates and numeric vectors of simulated days
+#' @return list with dates and numeric vectors of simulated days (initialization always starts on January first).
#'
-#' @keywords time serie
+#' @keywords time series
#'
-#' @importFrom magrittr subtract
-#' @importFrom magrittr %>%
#' @importFrom data.table as.IDate
#'
#' @noRd
-sim_time_serie <- function(start_date, end_date, nYR_init){
-
- time_serie_output_d <- start_date:end_date
-
- time_serie_output_t <- seq(1:length(time_serie_output_d))
-
- year_start <- start_date %>% format(., format="%Y") %>% as.numeric %>% subtract(nYR_init) %>% format(., format="%Y")
- start_date <- year_start %>% paste0(., "-", start_date %>% format(., format="%m-%d")) %>% as.IDate
-
- time_serie_date <- start_date : (end_date %>% as.IDate)
-
- time_serie_num <- c(0, seq(length(time_serie_date)-1))
-
- return(list(time_serie_date = time_serie_date %>% as.IDate,
- time_serie_num = time_serie_num,
- time_serie_output_d = time_serie_output_d %>% as.IDate,
- time_serie_output_t = time_serie_output_t)
-
- )
+sim_time_serie <- function(start_date, end_date, nYR_init) {
+ # Ensure dates are in Date format
+ start_date <- as.Date(start_date)
+ end_date <- as.Date(end_date)
+
+ # Generate output date sequence
+ time_serie_output_d <- seq.Date(start_date, end_date, by = "day")
+ time_serie_output_t <- seq_along(time_serie_output_d)
+
+ # Calculate the initialization start date
+ year_start <- as.numeric(format(start_date, "%Y")) - nYR_init
+ init_start_date <- as.IDate(paste0(year_start, "-01-01"))
+
+ # Generate initialization date sequence
+ time_serie_date <- seq.Date(init_start_date, end_date, by = "day")
+ time_serie_num <- seq_along(time_serie_date) - 1
+
+ return(list(
+ time_serie_date = time_serie_date,
+ time_serie_num = time_serie_num,
+ time_serie_output_d = time_serie_output_d,
+ time_serie_output_t = time_serie_output_t
+ ))
}
-
-
diff --git a/R/sysdata.rda b/R/sysdata.rda
new file mode 100644
index 0000000000000000000000000000000000000000..056d668db639ff35979b44696d0f58ce04db9826
Binary files /dev/null and b/R/sysdata.rda differ
diff --git a/README.md b/README.md
index 4fff620bd3fcac79fe74a8c6ffb96724d16e1ba5..3daff97cd849a3dd104c8da4b17a4337be7b8100 100644
--- a/README.md
+++ b/README.md
@@ -1,92 +1,40 @@
-# Dengue risk assessment
+# Aedes-borne diseases risk assessment
+<!-- badges: start -->
+<!-- badges: end -->
+The goal of arbocartoR is to guide the local development of effective strategies and interventions to mitigate the impact of these diseases on global health.
-## Getting started
-
-To make it easy for you to get started with GitLab, here's a list of recommended next steps.
-
-Already a pro? Just edit this README.md and make it your own. Want to make it easy? [Use the template at the bottom](#editing-this-readme)!
-
-## Add your files
+## Installation
-- [ ] [Create](https://docs.gitlab.com/ee/user/project/repository/web_editor.html#create-a-file) or [upload](https://docs.gitlab.com/ee/user/project/repository/web_editor.html#upload-a-file) files
-- [ ] [Add files using the command line](https://docs.gitlab.com/ee/gitlab-basics/add-file.html#add-a-file-using-the-command-line) or push an existing Git repository with the following command:
+You can install the development version of arbocartoR with the following code.
+Note that on Windows, you need to install [Rtools](https://cran.r-project.org/bin/windows/Rtools/).
+``` r
+install.packages("remotes")
+library(remotes)
+remotes::install_gitlab("umr-astre/arbocartoR", host = "https://forgemia.inra.fr")
```
-cd existing_repo
-git remote add origin https://forgemia.inra.fr/pachka.hammami/dengue-risk-assessment.git
-git branch -M main
-git push -uf origin main
-```
-
-## Integrate with your tools
-
-- [ ] [Set up project integrations](https://forgemia.inra.fr/pachka.hammami/dengue-risk-assessment/-/settings/integrations)
-
-## Collaborate with your team
-
-- [ ] [Invite team members and collaborators](https://docs.gitlab.com/ee/user/project/members/)
-- [ ] [Create a new merge request](https://docs.gitlab.com/ee/user/project/merge_requests/creating_merge_requests.html)
-- [ ] [Automatically close issues from merge requests](https://docs.gitlab.com/ee/user/project/issues/managing_issues.html#closing-issues-automatically)
-- [ ] [Enable merge request approvals](https://docs.gitlab.com/ee/user/project/merge_requests/approvals/)
-- [ ] [Automatically merge when pipeline succeeds](https://docs.gitlab.com/ee/user/project/merge_requests/merge_when_pipeline_succeeds.html)
-
-## Test and Deploy
-
-Use the built-in continuous integration in GitLab.
-
-- [ ] [Get started with GitLab CI/CD](https://docs.gitlab.com/ee/ci/quick_start/index.html)
-- [ ] [Analyze your code for known vulnerabilities with Static Application Security Testing(SAST)](https://docs.gitlab.com/ee/user/application_security/sast/)
-- [ ] [Deploy to Kubernetes, Amazon EC2, or Amazon ECS using Auto Deploy](https://docs.gitlab.com/ee/topics/autodevops/requirements.html)
-- [ ] [Use pull-based deployments for improved Kubernetes management](https://docs.gitlab.com/ee/user/clusters/agent/)
-- [ ] [Set up protected environments](https://docs.gitlab.com/ee/ci/environments/protected_environments.html)
-***
+## Example
-# Editing this README
+This is a basic example which shows you how to run simulations:
-When you're ready to make this README your own, just edit this file and use the handy template below (or feel free to structure it however you want - this is just a starting point!). Thank you to [makeareadme.com](https://www.makeareadme.com/) for this template.
+``` r
+library(arbocartoR)
+library(magrittr)
-## Suggestions for a good README
-Every project is different, so consider which of these sections apply to yours. The sections used in the template are suggestions for most open source projects. Also keep in mind that while a README can be too long and detailed, too long is better than too short. If you think your README is too long, consider utilizing another form of documentation rather than cutting out information.
+data(parcels)
+data(meteo)
-## Name
-Choose a self-explaining name for your project.
+parcels %<>% .[startsWith(ID, "06"),]
-## Description
-Let people know what your project can do specifically. Provide context and add a link to any reference visitors might be unfamiliar with. A list of Features or a Background subsection can also be added here. If there are alternatives to your project, this is a good place to list differentiating factors.
-
-## Badges
-On some READMEs, you may see small images that convey metadata, such as whether or not all the tests are passing for the project. You can use Shields to add some to your README. Many services also have instructions for adding a badge.
-
-## Visuals
-Depending on what you are making, it can be a good idea to include screenshots or even a video (you'll frequently see GIFs rather than actual videos). Tools like ttygif can help, but check out Asciinema for a more sophisticated method.
-
-## Installation
-Within a particular ecosystem, there may be a common way of installing things, such as using Yarn, NuGet, or Homebrew. However, consider the possibility that whoever is reading your README is a novice and would like more guidance. Listing specific steps helps remove ambiguity and gets people to using your project as quickly as possible. If it only runs in a specific context like a particular programming language version or operating system or has dependencies that have to be installed manually, also add a Requirements subsection.
-
-## Usage
-Use examples liberally, and show the expected output if you can. It's helpful to have inline the smallest example of usage that you can demonstrate, while providing links to more sophisticated examples if they are too long to reasonably include in the README.
-
-## Support
-Tell people where they can go to for help. It can be any combination of an issue tracker, a chat room, an email address, etc.
-
-## Roadmap
-If you have ideas for releases in the future, it is a good idea to list them in the README.
-
-## Contributing
-State if you are open to contributions and what your requirements are for accepting them.
-
-For people who want to make changes to your project, it's helpful to have some documentation on how to get started. Perhaps there is a script that they should run or some environment variables that they need to set. Make these steps explicit. These instructions could also be useful to your future self.
-
-You can also document commands to lint the code or run tests. These steps help to ensure high code quality and reduce the likelihood that the changes inadvertently break something. Having instructions for running tests is especially helpful if it requires external setup, such as starting a Selenium server for testing in a browser.
-
-## Authors and acknowledgment
-Show your appreciation to those who have contributed to the project.
+traj <- run_arbocartoR( parcels = parcels,
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ meteo = meteo)
+
+traj[[1]]
+```
-## License
-For open source projects, say how it is licensed.
-## Project status
-If you have run out of energy or time for your project, put a note at the top of the README saying that development has slowed down or stopped completely. Someone may choose to fork your project or volunteer to step in as a maintainer or owner, allowing your project to keep going. You can also make an explicit request for maintainers.
diff --git a/dengue-risk-assessment.Rproj b/arbocartoR.Rproj
similarity index 88%
rename from dengue-risk-assessment.Rproj
rename to arbocartoR.Rproj
index 497f8bfcfb9d13ad61d14d79963641e9aeab41b0..288819c8deab20ddacea55b58e9428cd22b8f741 100644
--- a/dengue-risk-assessment.Rproj
+++ b/arbocartoR.Rproj
@@ -1,4 +1,5 @@
Version: 1.0
+ProjectId: 42d00e2c-420f-4adf-81a2-2a05f583db50
RestoreWorkspace: Default
SaveWorkspace: Default
diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R
deleted file mode 100644
index 42f92ed4fa0aba1d452f1bce502d5e5f6c70f4a9..0000000000000000000000000000000000000000
--- a/data-raw/DATASET.R
+++ /dev/null
@@ -1,106 +0,0 @@
-#' Parcelle and meteo data
-#'
-#' @name PARCELLE and METEO data
-#' @docType data
-#' @format two data frame with columns:
-#' \describe{
-#' \item{poste}{...}
-#' }
-#' @source meteofrance and iris-ge
-#' @keywords datasets
-#'
-# # code to prepare `DATASET` dataset goes here
-# #### Meteorological data ####
-# meteo <- read.csv2("work_in_progress/data/meteo_20210101_20221130.txt")
-# meteo %>% setDT
-# meteo %<>% cleanmeteo
-#
-# meteo[, `:=`(TN = as.numeric(TN),
-# TX = as.numeric(TX))]
-# meteo[, TP := (TN+TX)/2]
-# meteo[, `:=`(TN = NULL,
-# TX = NULL)]
-#
-# ### List stations ###
-# STATIONS <- read.csv2("work_in_progress/data/stations.txt", sep = ";", dec = ".")
-# setDT(STATIONS)
-# STATIONS %<>% .[INSEE %in% meteo$POSTE] # Keep stations for which we have meteorological data
-# #remove unsed columns
-# STATIONS[, `:=`(TYPE = NULL,
-# NOM = NULL,
-# ETAT = NULL,
-# X = NULL)]
-# STATIONS[, ALTITUDE := substr(ALTITUDE, 1, 4) %>% as.numeric]
-#
-# #### List of administrative unit ####
-# filename <- "work_in_progress/data/IRIS-GE/IRIS_GE.SHP"
-# PARCELLE <- vect(filename)
-# terra::crs(PARCELLE, describe = T)
-# ### Test limit the number of parcelles
-# # PARCELLE %<>% .[startsWith(PARCELLE$INSEE_COM, "34"),]
-# # plot(PARCELLE)
-#
-# ### For each administrative unit define:
-#
-# ## Surface ##
-# PARCELLE$SURF_HA <- expanse(PARCELLE,
-# unit="ha",
-# transform=TRUE)
-#
-# ## KLfix KLvar KPfix KPvar - to improve based on land cover ##
-# PARCELLE$KLfix <- 150 * PARCELLE$SURF_HA
-# PARCELLE$KLvar <- 50 * PARCELLE$SURF_HA
-# PARCELLE$KPfix <- 150 * PARCELLE$SURF_HA
-# PARCELLE$KPvar <- 50 * PARCELLE$SURF_HA
-#
-# ## Average altitude ##
-# # download raster
-# elevation <- elevation_30s(country="FRA", path = "work_in_progress/data/")
-# # project raster
-# elevation %<>% project(., "epsg:2154")
-# # compute average
-# PARCELLE$ALTITUDE_UNIT <- terra::extract(elevation, PARCELLE, fun=mean, na.rm=TRUE) %>% .$FRA_elv_msk
-# # Absence of missing values?
-# PARCELLE$ALTITUDE_UNIT %>% is.na %>% sum %>% equals(0)
-# # Temporary replace na by 0 -- FIX ME LATER
-# # Ignore the error
-# # https://github.com/sneumann/xcms/issues/288
-# PARCELLE[is.na(PARCELLE$ALTITUDE_UNIT)]$ALTITUDE_UNIT <- 0
-#
-# ## Population ##
-# # download raster
-# pop <- geodata::population(2020, 0.5, path = "work_in_progress/data/")
-# # project raster
-# pop %<>% terra::project(., elevation)
-# # compute average
-# PARCELLE$POP <- terra::extract(pop, PARCELLE, fun=sum, na.rm=TRUE) %>% .$population_density
-# # Absence of missing values?
-# PARCELLE$POP %>% is.na %>% sum %>% equals(0)
-# # Turn density into number of persons
-# PARCELLE$POP %<>% multiply_by(PARCELLE$SURF_HA/100)
-#
-# ## Unique meteorological station ##
-# # two options: only spatial considerations or the weighted by the human population
-# # look at the function nearest from terra package
-#
-# # turn STATIONS data.table into points
-# STATIONS_pts <- STATIONS %>% vect(.,
-# geom=c("LONGITUDE", "LATITUDE"),
-# crs = "epsg:4326")
-# STATIONS_pts %<>% terra::project(., elevation)
-#
-# PARCELLE$STATION <- STATIONS[nearest(PARCELLE, STATIONS_pts) %>% .$to_id, INSEE]
-# PARCELLE$ALTITUDE_STATION <- STATIONS[nearest(PARCELLE, STATIONS_pts) %>% .$to_id, ALTITUDE]
-#
-# ## add the difference of altitude between the average altitude of the administrative unit and the altitude of the meteorological station (diff_alt = ALTITUDE_UNIT - ALTITUDE_STATION)
-# PARCELLE$diff_alt <- PARCELLE$ALTITUDE_UNIT - PARCELLE$ALTITUDE_STATION
-#
-# # turn PARCELLE into table
-# PARCELLE %<>% as.data.frame
-# setDT(PARCELLE)
-#
-# # save(meteo, file = "data/meteo.rda", compress = "bzip2")
-# # save(PARCELLE, file = "data/PARCELLE.rda", compress = "bzip2")
-# usethis::use_data(meteo, overwrite = TRUE)
-# usethis::use_data(PARCELLE, overwrite = TRUE)
-NULL
diff --git a/data/.gitignore b/data/.gitignore
deleted file mode 100644
index b1e54437876c9b8433e283a46992e87c816bf1b5..0000000000000000000000000000000000000000
--- a/data/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-PARCELLE.rda
-meteo.rda
diff --git a/data/PARCELLE.rda b/data/PARCELLE.rda
deleted file mode 100644
index 96997417e8f6863f471a223f80e44bd4cdee0dec..0000000000000000000000000000000000000000
Binary files a/data/PARCELLE.rda and /dev/null differ
diff --git a/data/SpatVec.dbf b/data/SpatVec.dbf
deleted file mode 100644
index c16292f0335e83b91a143ba4f6803254e113d6fc..0000000000000000000000000000000000000000
Binary files a/data/SpatVec.dbf and /dev/null differ
diff --git a/data/SpatVec.shp b/data/SpatVec.shp
deleted file mode 100644
index 29c9dcf0af942000cc41f9830edc414328939713..0000000000000000000000000000000000000000
Binary files a/data/SpatVec.shp and /dev/null differ
diff --git a/data/SpatVec.shx b/data/SpatVec.shx
deleted file mode 100644
index 91f466fd64db47f061303adff6e7f20504d75333..0000000000000000000000000000000000000000
Binary files a/data/SpatVec.shx and /dev/null differ
diff --git a/data/configK.Rda b/data/configK.Rda
new file mode 100644
index 0000000000000000000000000000000000000000..2d931210502676667ac5475884c8c5ba4a0cac9f
Binary files /dev/null and b/data/configK.Rda differ
diff --git a/data/meteo.rda b/data/meteo.rda
index 7d2941e55968a2dad41da7a3688a67fbc9b12699..fca71812a0fd61bbc709e6c8e1f4827eec6a14d8 100644
Binary files a/data/meteo.rda and b/data/meteo.rda differ
diff --git a/data/parcels.rda b/data/parcels.rda
new file mode 100644
index 0000000000000000000000000000000000000000..f3a9bca467d399cf771d073c5e23c989a1d0ab48
Binary files /dev/null and b/data/parcels.rda differ
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tfw b/inst/clc/U2018_CLC2018_V2020_20u1.tfw
new file mode 100644
index 0000000000000000000000000000000000000000..f9c5cdb4d4f218e019ca53730980c9316a8da2dc
--- /dev/null
+++ b/inst/clc/U2018_CLC2018_V2020_20u1.tfw
@@ -0,0 +1,6 @@
+100.0000000000
+0.0000000000
+0.0000000000
+-100.0000000000
+900050.0000000000
+5499950.0000000000
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tif b/inst/clc/U2018_CLC2018_V2020_20u1.tif
new file mode 100644
index 0000000000000000000000000000000000000000..3a53fd8df461f3b6998a8d7a9ccaebe6301b03b6
Binary files /dev/null and b/inst/clc/U2018_CLC2018_V2020_20u1.tif differ
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tif.aux.xml b/inst/clc/U2018_CLC2018_V2020_20u1.tif.aux.xml
new file mode 100644
index 0000000000000000000000000000000000000000..86958112accd7b2ef5c483cb9c2bf8b154a542bc
--- /dev/null
+++ b/inst/clc/U2018_CLC2018_V2020_20u1.tif.aux.xml
@@ -0,0 +1,28 @@
+<PAMDataset>
+ <Metadata>
+ <MDI key="DataType">Thematic</MDI>
+ </Metadata>
+ <PAMRasterBand band="1">
+ <Histograms>
+ <HistItem>
+ <HistMin>-128.5</HistMin>
+ <HistMax>127.5</HistMax>
+ <BucketCount>256</BucketCount>
+ <IncludeOutOfRange>1</IncludeOutOfRange>
+ <Approximate>0</Approximate>
+ <HistCounts>0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|800699|17085234|3210212|414626|122685|352020|820443|125373|201018|330596|1310736|121469220|10943399|821737|4112102|4304276|5247375|43061005|558481|24295716|27014639|3312024|58678001|81743560|31065342|21557169|17478178|10890506|29721311|763776|8952679|23594478|226982|1554720|1377227|11566473|586549|73892|1218413|1353727|12964044|652034|382221|148586809|0|0|0|40471|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0|0</HistCounts>
+ </HistItem>
+ </Histograms>
+ <Metadata>
+ <MDI key="RepresentationType">THEMATIC</MDI>
+ <MDI key="STATISTICS_COVARIANCES">136.429646247598</MDI>
+ <MDI key="STATISTICS_EXCLUDEDVALUES"></MDI>
+ <MDI key="STATISTICS_MAXIMUM">48</MDI>
+ <MDI key="STATISTICS_MEAN">25.753373398066</MDI>
+ <MDI key="STATISTICS_MINIMUM">1</MDI>
+ <MDI key="STATISTICS_SKIPFACTORX">1</MDI>
+ <MDI key="STATISTICS_SKIPFACTORY">1</MDI>
+ <MDI key="STATISTICS_STDDEV">11.680310194836</MDI>
+ </Metadata>
+ </PAMRasterBand>
+</PAMDataset>
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tif.ovr b/inst/clc/U2018_CLC2018_V2020_20u1.tif.ovr
new file mode 100644
index 0000000000000000000000000000000000000000..b11684d1350c9c2362ce346c8df849b206c3ae8b
Binary files /dev/null and b/inst/clc/U2018_CLC2018_V2020_20u1.tif.ovr differ
diff --git a/data/SpatVec.cpg b/inst/clc/U2018_CLC2018_V2020_20u1.tif.vat.cpg
similarity index 100%
rename from data/SpatVec.cpg
rename to inst/clc/U2018_CLC2018_V2020_20u1.tif.vat.cpg
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tif.vat.dbf b/inst/clc/U2018_CLC2018_V2020_20u1.tif.vat.dbf
new file mode 100644
index 0000000000000000000000000000000000000000..ecdce22e8ec3beabe1bc231c9fb68c0c9df8b5fc
Binary files /dev/null and b/inst/clc/U2018_CLC2018_V2020_20u1.tif.vat.dbf differ
diff --git a/inst/clc/U2018_CLC2018_V2020_20u1.tif.xml b/inst/clc/U2018_CLC2018_V2020_20u1.tif.xml
new file mode 100644
index 0000000000000000000000000000000000000000..cad7974a1804d3463ea4504c2fff5c814e86844c
--- /dev/null
+++ b/inst/clc/U2018_CLC2018_V2020_20u1.tif.xml
@@ -0,0 +1 @@
+<metadata xml:lang="en"><Esri><CreaDate>20191105</CreaDate><CreaTime>23392500</CreaTime><ArcGISFormat>1.0</ArcGISFormat><ArcGISstyle>FGDC CSDGM Metadata</ArcGISstyle><SyncOnce>FALSE</SyncOnce><DataProperties><lineage><Process ToolSource="c:\program files (x86)\arcgis\desktop10.6\ArcToolbox\Toolboxes\Spatial Analyst Tools.tbx\Reclassify" Date="20191105" Time="233925" Name="" export="">Reclassify CLC2018_CLC2018_V2018_20_rcls_8bit.tif Value "0 NODATA" E:\data\input\clc2018_8bit_rastr\reklasifikovane\status\8_bit\CLC2018_CLC2018_V2018_20_rcls_8bit_rcls.tif DATA</Process><Process ToolSource="c:\program files (x86)\arcgis\desktop10.6\ArcToolbox\Toolboxes\Data Management Tools.tbx\AddColormap" Date="20191106" Time="062448" Name="" export="">AddColormap e:\data\input\clc2018_8bit_rastr\reklasifikovane\status\8_bit\CLC2018_CLC2018_V2018_20_rcls_8bit_rcls.tif e:\data\input\clc2018_8bit_rastr\g100_clc12_V18_5.tif #</Process><Process Name="Join Field" ToolSource="c:\program files (x86)\arcgis\desktop10.7\ArcToolbox\Toolboxes\Data Management Tools.tbx\JoinField" Date="20191113" Time="094917" export="">JoinField F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\U2018_CLC2018_V2018_20_1.tif Value clc_legend GRID_CODE CLC_CODE;LABEL3</Process><Process Name="Join Field" ToolSource="c:\program files (x86)\arcgis\desktop10.7\ArcToolbox\Toolboxes\Data Management Tools.tbx\JoinField" Date="20191113" Time="105339" export="">JoinField F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\U2018_CLC2018_V2018_20_1.tif Value clc_legend GRID_CODE Red;Green;Blue</Process><Process Name="Add Field" ToolSource="c:\program files (x86)\arcgis\desktop10.7\ArcToolbox\Toolboxes\Data Management Tools.tbx\AddField" Date="20191113" Time="105546" export="">AddField F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\U2018_CLC2018_V2018_20_1.tif CODE_18 TEXT # # 3 # NULLABLE NON_REQUIRED #</Process><Process ToolSource="c:\program files (x86)\arcgis\desktop10.7\ArcToolbox\Toolboxes\Data Management Tools.tbx\CopyRaster" Date="20191113" Time="133252" Name="" export="">CopyRaster F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\U2018_CLC2018_V2018_20_1.tif F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\2019\U2018_CLC2018_V2018_20_1.tif # # -128 NONE NONE # NONE NONE TIFF NONE</Process><Process Name="Delete Colormap (11)" ToolSource="c:\program files (x86)\arcgis\desktop10.7\ArcToolbox\Toolboxes\Data Management Tools.tbx\DeleteColormap" Date="20191113" Time="134529" export="">DeleteColormap F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\rasters\status_8bit\2019\U2018_CLC2018_V2020_20_1.tif</Process></lineage><itemProps><itemName Sync="TRUE">U2018_CLC2018_V2020_20u1.tif</itemName><itemLocation><linkage Sync="TRUE">file://F:\data\___clc_seamless\_complete_delivery_repaired_FR_TR_included\___uprava_jmenne_konvence_oddeleni_doms_8bit_raster\delivery\__po_upravach_unor_2020\delivery\raster\U2018_CLC2018_V2020_20u1.tif</linkage><protocol Sync="TRUE">Local Area Network</protocol></itemLocation><nativeExtBox><westBL Sync="TRUE">900000.000000</westBL><eastBL Sync="TRUE">7400000.000000</eastBL><southBL Sync="TRUE">900000.000000</southBL><northBL Sync="TRUE">5500000.000000</northBL><exTypeCode Sync="TRUE">1</exTypeCode></nativeExtBox><imsContentType Sync="TRUE">002</imsContentType></itemProps><coordRef><type Sync="TRUE">Projected</type><geogcsn Sync="TRUE">GCS_ETRS_1989</geogcsn><csUnits Sync="TRUE">Linear Unit: Meter (1.000000)</csUnits><projcsn Sync="TRUE">ETRS_1989_LAEA</projcsn><peXml Sync="TRUE"><ProjectedCoordinateSystem xsi:type='typens:ProjectedCoordinateSystem' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xs='http://www.w3.org/2001/XMLSchema' xmlns:typens='http://www.esri.com/schemas/ArcGIS/10.7'><WKT>PROJCS[&quot;ETRS_1989_LAEA&quot;,GEOGCS[&quot;GCS_ETRS_1989&quot;,DATUM[&quot;D_ETRS_1989&quot;,SPHEROID[&quot;GRS_1980&quot;,6378137.0,298.257222101]],PRIMEM[&quot;Greenwich&quot;,0.0],UNIT[&quot;Degree&quot;,0.0174532925199433]],PROJECTION[&quot;Lambert_Azimuthal_Equal_Area&quot;],PARAMETER[&quot;False_Easting&quot;,4321000.0],PARAMETER[&quot;False_Northing&quot;,3210000.0],PARAMETER[&quot;Central_Meridian&quot;,10.0],PARAMETER[&quot;Latitude_Of_Origin&quot;,52.0],UNIT[&quot;Meter&quot;,1.0],AUTHORITY[&quot;EPSG&quot;,3035]]</WKT><XOrigin>-8426600</XOrigin><YOrigin>-9526700</YOrigin><XYScale>353290001.83332509</XYScale><ZOrigin>-100000</ZOrigin><ZScale>10000</ZScale><MOrigin>-100000</MOrigin><MScale>10000</MScale><XYTolerance>0.001</XYTolerance><ZTolerance>0.001</ZTolerance><MTolerance>0.001</MTolerance><HighPrecision>true</HighPrecision><WKID>3035</WKID><LatestWKID>3035</LatestWKID></ProjectedCoordinateSystem></peXml></coordRef><RasterProperties><General><PixelDepth Sync="TRUE">8</PixelDepth><HasColormap Sync="TRUE">FALSE</HasColormap><CompressionType Sync="TRUE">PACKBITS</CompressionType><NumBands Sync="TRUE">1</NumBands><Format Sync="TRUE">TIFF</Format><HasPyramids Sync="TRUE">TRUE</HasPyramids><SourceType Sync="TRUE">discrete</SourceType><PixelType Sync="TRUE">signed integer</PixelType><NoDataValue Sync="TRUE">-128</NoDataValue></General></RasterProperties></DataProperties><SyncDate>20200309</SyncDate><SyncTime>11011300</SyncTime><ModDate>20200309</ModDate><ModTime>11011300</ModTime><ArcGISProfile>INSPIRE</ArcGISProfile><scaleRange><minScale>150000000</minScale><maxScale>5000</maxScale></scaleRange></Esri><mdChar><CharSetCd value="004"/></mdChar><mdContact><rpOrgName>European Environment Agency</rpOrgName><rpCntInfo><cntAddress><delPoint>Kongens Nytorv 6</delPoint><city>Copenhagen</city><adminArea>K</adminArea><postCode>1050</postCode><country>DK</country><eMailAdd>sdi@eea.europa.eu</eMailAdd></cntAddress></rpCntInfo></mdContact><mdStanName>ArcGIS Metadata</mdStanName><mdStanVer>1.0</mdStanVer><distInfo><distTranOps><onLineSrc><linkage>http://land.copernicus.eu/pan-european/corine-land-cover/clc2018/view</linkage><protocol>WWW:LINK-1.0-http--link</protocol></onLineSrc></distTranOps><distFormat><formatName Sync="TRUE">Raster Dataset</formatName></distFormat></distInfo><dataIdInfo><idCitation><resTitle Sync="FALSE">Corine Land Cover 2018 European seamless raster file: Status 2018 layer (CLC2018)</resTitle><date><pubDate>2020-02-24T00:00:00</pubDate></date><resEd>20u1</resEd><citId><identCode>Corine Land Cover (CLC) 2018, Version 2020 20u1</identCode></citId><presForm><PresFormCd value="005" Sync="TRUE"/></presForm></idCitation><idAbs><DIV STYLE="text-align:Left;"><DIV><DIV><P><SPAN>CLC2018 is one of the Corine Land Cover (CLC) datasets produced within the frame the Copernicus Land Monitoring Service referring to land cover / land use status of year 2018. CLC service has a long-time heritage (formerly known as "CORINE Land Cover Programme"), coordinated by the European Environment Agency (EEA). It provides consistent and thematically detailed information on land cover and land cover changes across Europe. CLC datasets are based on the classification of satellite images produced by the national teams of the participating countries - the EEA members and cooperating countries (EEA39). National CLC inventories are then further integrated into a seamless land cover map of Europe. The resulting European database relies on standard methodology and nomenclature with following base parameters: 44 classes in the hierarchical 3-level CLC nomenclature; minimum mapping unit (MMU) for status layers is 25 hectares; minimum width of linear elements is 100 metres. Change layers have higher resolution, i.e. minimum mapping unit (MMU) is 5 hectares for Land Cover Changes (LCC), and the minimum width of linear elements is 100 metres. The CLC service delivers important data sets supporting the implementation of key priority areas of the Environment Action Programmes of the European Union as e.g. protecting ecosystems, halting the loss of biological diversity, tracking the impacts of climate change, monitoring urban land take, assessing developments in agriculture or dealing with water resources directives. CLC belongs to the Pan-European component of the Copernicus Land Monitoring Service (https://land.copernicus.eu/), part of the European Copernicus Programme coordinated by the European Environment Agency, providing environmental information from a combination of air- and space-based observation systems and in-situ monitoring. Additional information about CLC product description including mapping guides can be found at https://land.copernicus.eu/user-corner/technical-library/clc2018technicalguidelines_final.pdf. CLC class descriptions can be found at https://land.copernicus.eu/user-corner/technical-library/corine-land-cover-nomenclature-guidelines/html/.</SPAN></P></DIV></DIV></DIV></idAbs><idPoC><rpOrgName>European Environment Agency (EEA) under the framework of the Copernicus programme</rpOrgName><rpCntInfo><cntAddress><delPoint>Kongens Nytorv 6</delPoint><city>Copenhagen</city><adminArea>K</adminArea><postCode>1050</postCode><country>DK</country><eMailAdd>copernicus@eea.europa.eu</eMailAdd></cntAddress><cntOnlineRes><linkage>http://www.eea.europa.eu</linkage><protocol>WWW:LINK-1.0-http--link</protocol><orName>European Environment Agency public website</orName></cntOnlineRes></rpCntInfo></idPoC><graphOver><bgFileName>https://sdi.eea.europa.eu/public/catalogue-graphic-overview/blank.png</bgFileName></graphOver><placeKeys><thesaName><resTitle>Continents, countries, sea regions of the world</resTitle><date><pubDate>2015-07-17T00:00:00</pubDate></date><citId><identCode>geonetwork.thesaurus.external.place.regions</identCode></citId></thesaName><keyword>Albania, Austria, Belgium, Bosnia and Herzegovina, Bulgaria, Croatia, Cyprus, Czech Republic, Denmark, Estonia, Finland, France, Germany, Greece, Hungary, Iceland, Ireland, Italy, Kosovo, Latvia, Liechtenstein, Lithuania, Luxembourg, Malta, Montenegro, Netherlands, North Macedonia, Norway, Poland, Portugal, Romania, Serbia, Slovakia, Slovenia, Spain, Sweden, Switzerland, Turkey, United Kingdom</keyword></placeKeys><themeKeys><thesaName><resTitle>EEA categories</resTitle><date><pubDate>2010-07-06T00:00:00</pubDate></date><citId><identCode>geonetwork.thesaurus.local.theme.eea-categories</identCode></citId></thesaName><keyword>geospatial data</keyword></themeKeys><themeKeys><thesaName><resTitle>GEMET - INSPIRE themes, version 1.0</resTitle><date><pubDate>2008-06-01T00:00:00</pubDate></date><citId><identCode>geonetwork.thesaurus.external.theme.httpinspireeceuropaeutheme-theme</identCode></citId></thesaName></themeKeys><themeKeys><thesaName><resTitle>GEMET</resTitle><date><pubDate>2018-08-16T00:00:00</pubDate></date><citId><identCode>geonetwork.thesaurus.external.theme.gemet</identCode></citId></thesaName></themeKeys><otherKeys><thesaName><resTitle>EEA keyword list</resTitle><date><pubDate>2002-03-01T00:00:00</pubDate></date></thesaName><keyword>Copernicus Land Satellite Image Interpretation 2018 Corine Land Cover Raster CLC Polygon</keyword></otherKeys><searchKeys><keyword>Albania</keyword><keyword>Austria</keyword><keyword>Belgium</keyword><keyword>Bosnia and Herzegovina</keyword><keyword>Bulgaria</keyword><keyword>Croatia</keyword><keyword>Cyprus</keyword><keyword>Czech Republic</keyword><keyword>Denmark</keyword><keyword>Estonia</keyword><keyword>Finland</keyword><keyword>France</keyword><keyword>Germany</keyword><keyword>Greece</keyword><keyword>Hungary</keyword><keyword>Iceland</keyword><keyword>Ireland</keyword><keyword>Italy</keyword><keyword>Kosovo</keyword><keyword>Latvia</keyword><keyword>Liechtenstein</keyword><keyword>Lithuania</keyword><keyword>Luxembourg</keyword><keyword>Malta</keyword><keyword>Montenegro</keyword><keyword>Netherlands</keyword><keyword>North Macedonia</keyword><keyword>Norway</keyword><keyword>Poland</keyword><keyword>Portugal</keyword><keyword>Romania</keyword><keyword>Serbia</keyword><keyword>Slovakia</keyword><keyword>Slovenia</keyword><keyword>Spain</keyword><keyword>Sweden</keyword><keyword>Switzerland</keyword><keyword>Turkey</keyword><keyword>United Kingdom</keyword><keyword>geospatial data</keyword><keyword>Copernicus Land Satellite Image Interpretation 2018 Corine Land Cover Raster CLC Polygon</keyword></searchKeys><resConst><LegConsts><othConsts>no limitations to public access</othConsts></LegConsts></resConst><dataExt><geoEle><GeoBndBox><westBL>-31.561261</westBL><eastBL>44.820775</eastBL><southBL>27.405827</southBL><northBL>71.409109</northBL></GeoBndBox></geoEle></dataExt><envirDesc Sync="TRUE">Microsoft Windows 7 Version 6.1 (Build 7601) Service Pack 1; Esri ArcGIS 10.7.1.11595</envirDesc><dataLang><languageCode value="ces" Sync="TRUE"/><countryCode value="CZE" Sync="TRUE"/></dataLang><spatRpType><SpatRepTypCd value="002" Sync="TRUE"/></spatRpType><dataExt><geoEle xmlns=""><GeoBndBox esriExtentType="search"><exTypeCode Sync="TRUE">1</exTypeCode><westBL Sync="TRUE">-56.505142</westBL><eastBL Sync="TRUE">72.906137</eastBL><northBL Sync="TRUE">72.664410</northBL><southBL Sync="TRUE">24.284177</southBL></GeoBndBox></geoEle></dataExt><tpCat><TopicCatCd value="007"/></tpCat><tpCat><TopicCatCd value="010"/></tpCat></dataIdInfo><dqInfo><report type="DQDomConsis"><measResult><ConResult><conSpec><resTitle>Commission Regulation (EU) No 1089/2010 of 23 November 2010 implementing Directive 2007/2/EC of the European Parliament and of the Council as regards interoperability of spatial data sets and services</resTitle><date><pubDate>2010-12-08T00:00:00</pubDate></date></conSpec><conExpl>See the referenced specification</conExpl><conPass>false</conPass></ConResult></measResult></report><dataLineage><statement>CLC products are based in majority of EEA39 countries on the photointerpretation of satellite images by the national teams of the participating countries - the EEA member and cooperating countries. All features in original vector database are delineated and classified on satellite images according to CLC specifications i.e. with better than 100 m positional accuracy and 25 ha minimum mapping unit (5 ha MMU for change layer) into the standardized CLC nomenclature (44 CLC classes). The change layer is derived from satellite imagery by direct mapping of changes taken place between two consecutive inventories, based on image-to-image comparison. Some countries follow alternative approaches by utilizing semiautomatic methodology e.g. generalisation of higher resolution national datasets. Production of national CLC inventories is supported by training and is under systematic control of the CLC Technical Team, both for thematic and semantic aspects, to assure harmonized European products. The process of European data integration starts when national deliveries are accepted and the Database Acceptance Report (DBTA) issued. National CLC data are then transformed into the common European reference (ETRS89/LAEA) and pan-European seamless dataset is produced. Integration step includes also harmonization of database along country borders. Rigorous harmonization of country borders has been done only for CLC2000 and CHA9000 layers (in 2 km wide strips along borders) as part of CLC2000 update. Currently, only simplified harmonisation is applied i.e. small border polygons (area < 5 ha) are generalised according to predefined rules to largest and/or thematically most similar neighbour, sliver polygons along borders (< 0.1 ha) are eliminated. European Corine Land Cover seamless database represents the final product of European data integration. Some artificial lines (dividing polygons with the same code) can be still present in database due to technical constraints of current ArcGIS technology and complexity of dataset (adaptive tiling) but this has no impact on dataset contents and can be dissolved for smaller data extracts. Revised versions Started from the publication of CLC2006 (Version 16) the previous inventory is substituted by its revised version by most of the participating countries (see CLC seamless data coverage table https://land.copernicus.eu/user-corner/technical-library/clc-country-coverage-1990-2018-v20u1). However, due to their specific methodology not all countries are producing revised version of the previous inventory. The revision of previous CLC layer is a “by-product†of the standard updating process, including corrections to the original data identified during the update. Revisions (correcting mistakes) are needed because of the following factors: - availability of higher resolution satellite imagery; - a new satellite image or time series of satellite imagery provides additional key to correctly recognise a feature; - improved availability and better quality of in-situ data; - improved skills of experts, i.e. better understanding and application of CLC nomenclature; - decision of the national team to improve the product between two inventories. These revisions are not propagated backward to older datasets (e.g. during CLC2018 revision of CLC2012 might be provided, but the older datasets were not revised). Thus, consecutive inventories might include not only real changes, but also differences due to revisions. Therefore, it is recommended that in time series analysis CLC-Change layers should be used. If status layers from past are needed, these could be derived backward from deducting CLC-Change layers from the latest (best available) status layer as it is done for EEA accounting layers (see at https://www.eea.europa.eu/data-and-maps/data/corine-land-cover-accounting-layers) More details to be available soon in upcoming "Users' Manual for all Copernicus data†document. Version 20u1 Release date: 24-02-2020 File naming conventions simplified and better described. New file naming convention has been introduced based on user feedback on version 20. Filename is composed of combination of information about update campaign, data theme and reference year and version specification (including release year and release number). See https://land.copernicus.eu/user-corner/technical-library/clc-file-naming-conventions-guide-v20u1 for details. The French DOMs are provided in separate databases (files both for vector and raster version of data). All raster layers are back in 8 bit GeoTIFF. Modification is introduced based on the user feedback on version 20. In order to keep 8 bit resolution for raster change layers, they are divided into two files - representing consumption (from) and formation (to) part of change. See https://land.copernicus.eu/user-corner/technical-library/clc-country-coverage-1990-2018-v20u1 for full information about the coverage of this version. See http://land.copernicus.eu/user-corner/technical-library/clc-and-clcc-release-lineage for full information about lineage history.</statement></dataLineage></dqInfo><spatRepInfo><Georect><axisDimension type="002"><dimSize Sync="TRUE">65000</dimSize><dimResol><value Sync="TRUE" uom="m">100.000000</value></dimResol></axisDimension><axisDimension type="001"><dimSize Sync="TRUE">46000</dimSize><dimResol><value Sync="TRUE" uom="m">100.000000</value></dimResol></axisDimension><cellGeo><CellGeoCd Sync="TRUE" value="002"/></cellGeo><numDims Sync="TRUE">2</numDims><tranParaAv Sync="TRUE">1</tranParaAv><chkPtAv Sync="TRUE">0</chkPtAv><cornerPts><pos Sync="TRUE">900000.000000 900000.000000</pos></cornerPts><cornerPts><pos Sync="TRUE">900000.000000 5500000.000000</pos></cornerPts><cornerPts><pos Sync="TRUE">7400000.000000 5500000.000000</pos></cornerPts><cornerPts><pos Sync="TRUE">7400000.000000 900000.000000</pos></cornerPts><centerPt><pos Sync="TRUE">4150000.000000 3200000.000000</pos></centerPt><ptInPixel><PixOrientCd Sync="TRUE" value="001"/></ptInPixel></Georect></spatRepInfo><refSysInfo><RefSystem><refSysID><identCode code="EPSG:3035"/><idCodeSpace Sync="TRUE">EPSG</idCodeSpace><idVersion Sync="TRUE">8.1(9.0.0)</idVersion></refSysID></RefSystem></refSysInfo><contInfo><ImgDesc><covDim><Band><valUnit><UOM type="length"/></valUnit><dimDescrp Sync="TRUE">Band_1</dimDescrp><maxVal Sync="TRUE">48.000000</maxVal><minVal Sync="TRUE">1.000000</minVal><bitsPerVal Sync="TRUE">8</bitsPerVal></Band></covDim><contentTyp><ContentTypCd Sync="TRUE" value="002"/></contentTyp></ImgDesc></contInfo><eainfo><detailed Name="U2018_CLC2018_V2020_20u1.tif.vat"><enttyp><enttypl Sync="TRUE">U2018_CLC2018_V2020_20u1.tif.vat</enttypl><enttypt Sync="TRUE">Table</enttypt><enttypc Sync="TRUE">45</enttypc></enttyp><attr><attrlabl Sync="TRUE">OID</attrlabl><attalias Sync="TRUE">OID</attalias><attrtype Sync="TRUE">OID</attrtype><attwidth Sync="TRUE">4</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale><attrdef Sync="TRUE">Internal feature number.</attrdef><attrdefs Sync="TRUE">Esri</attrdefs><attrdomv><udom Sync="TRUE">Sequential unique whole numbers that are automatically generated.</udom></attrdomv></attr><attr><attrlabl Sync="TRUE">Value</attrlabl><attalias Sync="TRUE">Value</attalias><attrtype Sync="TRUE">Integer</attrtype><attwidth Sync="TRUE">10</attwidth><atprecis Sync="TRUE">10</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Count</attrlabl><attalias Sync="TRUE">Count</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">LABEL3</attrlabl><attalias Sync="TRUE">LABEL3</attalias><attrtype Sync="TRUE">String</attrtype><attwidth Sync="TRUE">254</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Red</attrlabl><attalias Sync="TRUE">Red</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Green</attrlabl><attalias Sync="TRUE">Green</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">Blue</attrlabl><attalias Sync="TRUE">Blue</attalias><attrtype Sync="TRUE">Double</attrtype><attwidth Sync="TRUE">19</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr><attr><attrlabl Sync="TRUE">CODE_18</attrlabl><attalias Sync="TRUE">CODE_18</attalias><attrtype Sync="TRUE">String</attrtype><attwidth Sync="TRUE">3</attwidth><atprecis Sync="TRUE">0</atprecis><attscale Sync="TRUE">0</attscale></attr></detailed></eainfo><mdLang><languageCode value="ces" Sync="TRUE"/><countryCode value="CZE" Sync="TRUE"/></mdLang><mdHrLv><ScopeCd value="005" Sync="TRUE"/></mdHrLv><mdHrLvName Sync="TRUE">dataset</mdHrLvName><mdDateSt Sync="TRUE">20200309</mdDateSt></metadata>
diff --git a/inst/shape/SpatVec.cpg b/inst/shape/SpatVec.cpg
new file mode 100644
index 0000000000000000000000000000000000000000..3ad133c048f2189041151425a73485649e6c32c0
--- /dev/null
+++ b/inst/shape/SpatVec.cpg
@@ -0,0 +1 @@
+UTF-8
\ No newline at end of file
diff --git a/inst/shape/SpatVec.dbf b/inst/shape/SpatVec.dbf
new file mode 100644
index 0000000000000000000000000000000000000000..124f9c43d21195cd80b8d232d00fdd81a5eb1e48
Binary files /dev/null and b/inst/shape/SpatVec.dbf differ
diff --git a/data/SpatVec.prj b/inst/shape/SpatVec.prj
similarity index 100%
rename from data/SpatVec.prj
rename to inst/shape/SpatVec.prj
diff --git a/inst/shape/SpatVec.shp b/inst/shape/SpatVec.shp
new file mode 100644
index 0000000000000000000000000000000000000000..42e4b72122816040d6dc1d4cf284d26427e9905e
Binary files /dev/null and b/inst/shape/SpatVec.shp differ
diff --git a/inst/shape/SpatVec.shx b/inst/shape/SpatVec.shx
new file mode 100644
index 0000000000000000000000000000000000000000..65b682c2a90cd763e10f20df24ef366d8f99b38f
Binary files /dev/null and b/inst/shape/SpatVec.shx differ
diff --git a/man/build_E_random.Rd b/man/build_E_random.Rd
index dd2380c6e053ce8b02f1aaeab5afeacdb4c57240..932aca5dafe5671780814dc17680684fbd1ffe57 100644
--- a/man/build_E_random.Rd
+++ b/man/build_E_random.Rd
@@ -2,33 +2,47 @@
% Please edit documentation in R/build_E_random.R
\name{build_E_random}
\alias{build_E_random}
-\title{Generate the list of introduction event}
+\title{Generate a list of introduction events}
\usage{
-build_E_random(period_start, period_end, n_ind = 1, n_events = 1, stage = "Eh", loc)
+build_E_random(
+ period_start,
+ period_end = period_start,
+ n_events = NULL,
+ n_ind = NULL,
+ stage = "Eh",
+ loc
+)
}
\arguments{
-\item{period_start}{date in '\%Y-\%m-\%d' format. Define the beginning of the period for introduction.}
+\item{period_start}{Date in '\%Y-\%m-\%d' format. Defines the beginning of the period for introduction.}
-\item{period_end}{date in '\%Y-\%m-\%d' format. Define the end of the period for introduction.}
+\item{period_end}{Date in '\%Y-\%m-\%d' format. Defines the end of the period for introduction.}
-\item{n_ind}{Numerical vector. Range of number of individuals introduced.}
+\item{n_events}{Numeric value. Number of introduction events generated.}
-\item{n_events}{String vector. Number of introduction generated.}
+\item{n_ind}{Numeric value. Number of individuals introduced.}
-\item{stage}{String vector. Epidemiological stage of introduced individuals.}
+\item{stage}{Character vector. Epidemiological stage of introduced individuals.}
-\item{loc}{String or numerical vector. List of patch to seed random introductions.}
+\item{loc}{Character or numeric vector. List of patches to seed random introductions.}
}
\value{
-events matrix with scheduled introductions
+Data frame with scheduled introductions.
}
\description{
-Function used to generate the random introduction.
-The introduction events generated can occurs in different locations and at different dates in a given period.
-The number of individuals introduced and their epidemiological stages can be deterministic (unique value provided) or random (randomly selected in a vector of values).
+Function used to generate a random list of schedule introduction.
+The introduction events generated can occur in different locations and at different dates in a given period.
+The number of individuals introduced is randomly distributed over all the events.
+If the number of events is not provided, location and date are randomly sampled for each introduced individual.
+The epidemiological stage can be either deterministic (unique value provided) or random (randomly selected in a vector of values).
}
\examples{
-build_E_random(period_start = as.Date("2020/03/10"), period_end = as.Date("2020/09/30"), n_ind = 1, n_events = 10, stage = "Eh", loc = LETTERS[1:3])
+\dontrun{
+build_E_random(period_start = as.Date("2020/03/10"),
+period_end = as.Date("2020/09/30"),
+n_ind = NULL, n_events = 10,
+stage = "Eh", loc = LETTERS[1:3])
+}
}
\keyword{events}
diff --git a/man/build_gdata.Rd b/man/build_gdata.Rd
index 104b562a48fe0e40a1b52dbd022c7a4be90c39d0..5ad52a400b195607940532f75d9679a6e4d5b8df 100644
--- a/man/build_gdata.Rd
+++ b/man/build_gdata.Rd
@@ -4,12 +4,74 @@
\alias{build_gdata}
\title{Generate global parameters list}
\usage{
-build_gdata()
+build_gdata(
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ bHM = NULL,
+ bMH = NULL,
+ muH = NULL,
+ rhoH = NULL,
+ muE = NULL,
+ TE = NULL,
+ TDDE = NULL,
+ q1E = NULL,
+ q2E = NULL,
+ q3E = NULL,
+ q4E = NULL,
+ q5E = NULL,
+ q6E = NULL,
+ mu1L = NULL,
+ mu2L = NULL,
+ mu3L = NULL,
+ q1L = NULL,
+ q2L = NULL,
+ q3L = NULL,
+ q4L = NULL,
+ q5L = NULL,
+ q6L = NULL,
+ muEM = NULL,
+ mu1P = NULL,
+ mu2P = NULL,
+ mu3P = NULL,
+ q1P = NULL,
+ q2P = NULL,
+ q3P = NULL,
+ q4P = NULL,
+ q5P = NULL,
+ q6P = NULL,
+ mu1A = NULL,
+ mu2A = NULL,
+ mu3A = NULL,
+ gammaAem = NULL,
+ sigma = NULL,
+ gammaAh = NULL,
+ muR = NULL,
+ TAG = NULL,
+ TDDAG = NULL,
+ q1Ag = NULL,
+ q2Ag = NULL,
+ q3Ag = NULL,
+ q4Ag = NULL,
+ q5Ag = NULL,
+ q6Ag = NULL,
+ gammaAo = NULL,
+ beta1 = NULL,
+ beta2 = NULL,
+ maxbite = NULL,
+ startFav = NULL,
+ endFav = NULL,
+ muErain = NULL,
+ muLrain = NULL,
+ muPrain = NULL,
+ verbose = T
+)
}
\arguments{
-\item{vector_species}{string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.}
+\item{vector}{string. "Ae. albopictus", "Ae. albopictus (D)" or "Ae. aegypti". Default is "Ae. albopictus (D)".}
+
+\item{virus}{string. "DEN" (dengue), "ZIK" (zika) or "CHI" (chikungunya). Default is "DEN" (dengue) virus.}
-\item{bHM}{numeric. Probability of infection from host to vector when an infected human is bitten by an susceptible mosquito.}
+\item{bHM}{numeric. Probability of infection from host to vector when an infected host is bitten by an susceptible vector}
\item{bMH}{numeric. Probability of infection from vector to host when a human is bitten by an infected mosquito.}
@@ -19,35 +81,59 @@ build_gdata()
\item{muE}{numeric. Daily mortality rate of eggs (1/days)}
-\item{TE}{numeric. Minimal temperature needed for egg development (°C)}
+\item{TE}{numeric. Minimal temperature needed for albopictus eggs development (°C) (see details of albopictus functions)}
+
+\item{TDDE}{numeric. Total number of degree-day necessary for albopictus eggs development (°C) (see details of albopictus functions)}
+
+\item{q1E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{q2E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{q3E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{q4E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{q5E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{q6E}{numeric. Parameter for the aegypti egg development function (see details of aegypti functions)}
+
+\item{mu1L}{numeric. Parameter for the larvae mortality function (see details)}
-\item{TDDE}{numeric. Total number of degree-day necessary for egg development (°C)}
+\item{mu2L}{numeric. Parameter for the larvae mortality function (see details)}
-\item{mu1L}{numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}}
+\item{mu3L}{numeric. Parameter for the larvae mortality function (see details)}
-\item{mu2L}{numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}}
+\item{q1L}{numeric. Parameter for the function of transition from larva to pupa (see details)}
-\item{mu3L}{numeric. Parameter for the larvae mortality function: \eqn{ mu1L \times e^{(temperature_{t}-10) \times mu2L} + mu3L}}
+\item{q2L}{numeric. Parameter for the function of transition from larva to pupa (see details)}
-\item{q1L}{numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}}
+\item{q3L}{numeric. Parameter for the function of transition from larva to pupa (see details)}
-\item{q2L}{numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}}
+\item{q4L}{numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)}
-\item{q3L}{numeric. Parameter for the function of transition from larva to pupa \eqn{q1L \times temperature_{t}^{2} + q2L \times temperature_{t} + q3L}}
+\item{q5L}{numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)}
+
+\item{q6L}{numeric. Parameter for the function of transition from larva to pupa (see details of aegypti functions)}
\item{muEM}{numeric. Daily mortality rate of emerging adults during the emergence (1/days)}
-\item{mu1P}{numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}}
+\item{mu1P}{numeric. Parameter for the pupae mortality function (see details)}
+
+\item{mu2P}{numeric. Parameter for the pupae mortality function (see details)}
+
+\item{mu3P}{numeric. Parameter for the pupae mortality function (see details)}
-\item{mu2P}{numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}}
+\item{q1P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details)}
-\item{mu3P}{numeric. Parameter for the larvae mortality function: \eqn{mu1P \times e^{(temperature_{t}-10) \times mu2P} + mu3P}}
+\item{q2P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details)}
-\item{q1P}{numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}}
+\item{q3P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details)}
-\item{q2P}{numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}}
+\item{q4P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)}
-\item{q3P}{numeric. Parameter for the function of transition from pupae to emerging adult \eqn{q1P \times temperature_{t}^{2} + q2P \times temperature_{t} + q3P}}
+\item{q5P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)}
+
+\item{q6P}{numeric. Parameter for the function of transition from pupae to emerging adult (see details of aegypti functions)}
\item{mu1A}{numeric. Parameter for the adult mortality function: \eqn{mu1A \times e^{(temperature_{t}-10) \times mu2A} + mu3A}}
@@ -63,9 +149,21 @@ build_gdata()
\item{muR}{numeric. Daily mortality rate related to seeking behavior (1/days)}
-\item{TAG}{numeric. Minimal temperature needed for egg maturation (°C)}
+\item{TAG}{numeric. Minimal temperature needed for egg maturation (°C) (see details of albopictus functions)}
+
+\item{TDDAG}{numeric. Total number of degree-days necessary for egg maturation (°C) (see details of albopictus functions)}
+
+\item{q1Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
+
+\item{q2Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
+
+\item{q3Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
+
+\item{q4Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
-\item{TDDAG}{numeric. Total number of degree-days necessary for egg maturation (°C)}
+\item{q5Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
+
+\item{q6Ag}{numeric. Parameter for the function driving eggs maturation after blood meal (see details of aegypti functions)}
\item{gammaAo}{numeric. Daily transition rate from oviposition site-seeking to host-seeking adults (1/days)}
@@ -73,13 +171,19 @@ build_gdata()
\item{beta2}{numeric. Number of eggs laid by ovipositing parous females (per female)}
-\item{startFav}{date. First day of the favorable period for the mosquito (depend on the species and the environment).}
+\item{maxbite}{numeric. Maximal number of bite per human.}
+
+\item{startFav}{date. First day of the favorable period for diapausing mosquitos.}
+
+\item{endFav}{date. Last day of the favorable period for diapausing mosquitos.}
-\item{endFav}{date. Last day of the favorable period for the mosquito (depend on the species and the environment).}
+\item{muErain}{numeric. Additional mortality of eggs due to heavy rain (> 80mm)}
-\item{verbose}{logical. Provide information on parameters during generation}
+\item{muLrain}{numeric. Additional mortality of larvae due to heavy rain (> 80mm)}
-\item{climat}{string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date.}
+\item{muPrain}{numeric. Additional mortality of pupae due to heavy rain (> 80mm)}
+
+\item{verbose}{logical. Provide additional information on parameters during generation}
}
\value{
Named list of parameters
@@ -87,6 +191,35 @@ Named list of parameters
\description{
The functions formats all global parameters required for the model.
}
+\details{
+Aegypti (with \eqn{temperature\_K_{t}} the daily temperature in kalvin):
+
+egg development function: \eqn{(q1E \times temperature\_K_{t} \times q2E \times e^{(q4E - (1 / temperature\_K_{t}))}) / (1 + e^{q5E \times (q6E - 1 / temperature\_K_{t})})}
+
+transition function from larva to pupa: \eqn{(q1L \times temperature\_K_{t} \times q2L) \times e^{q3L \times (q4L - 1 / temperature\_K_{t})} / (1 + e^{q5L \times (q6L - 1 / temperature\_K_{t})})}
+
+transition function from pupa to emerging adult: \eqn{(q1P \times temperature\_K_{t} \times q2P) \times e^{q3P \times (q4P - 1 / temperature\_K_{t})} / (1 + e^{q5P \times (q6P- 1 / temperature\_K_{t})})}
+
+function for eggs maturation after blood meal: \eqn{(q1Ag \times temperature\_K_{t} \times q2Ag ) \times e^{q3Ag \times (q4Ag - 1 / temperature\_K_{t})} / (1 + e^{q5Ag \times (q6Ag - 1 / temperature\_K_{t})})}
+
+Albopictus (with \eqn{temperature\_C_{t}} the daily temperature in celsius degree):
+
+egg development function: \eqn{(temperature\_C_{t} - TE) / TDDE}
+
+larvae mortality function: \eqn{ mu1L \times e^{(temperature\_C_{t}-10) \times mu2L} + mu3L}
+
+transition function from larva to pupa: \eqn{q1L \times temperature\_C_{t}^{2} + q2L \times temperature\_C_{t}+ q3L}
+
+transition function from pupae to emerging adult: \eqn{q1P \times temperature\_C_{t}^{2} + q2P \times temperature\_C_{t} + q3P}
+
+function for eggs maturation after blood meal: \eqn{(temperature\_C_{t} - TAG )/ TDDAG}
+
+Both:
+
+Larvae mortality function: \eqn{(mu1L \times e^{(temperature\_C_{t} - 10)\times mu2L} + mu3L)\times (1 + Lm/kL)}, with Lm the number of larvae and kL the carrying capacity (density dependance)
+
+Pupae mortality function: \eqn{mu1P \times e^{(temperature\_C_{t}-10) \times mu2P} + mu3P}
+}
\examples{
build_gdata()
diff --git a/man/build_ldata.Rd b/man/build_ldata.Rd
index 1118bffa4090e2efaa1274a6be72c1c2ffa294f4..abee5a95c0adaa5e03d940cc88e6b950e8db943a 100644
--- a/man/build_ldata.Rd
+++ b/man/build_ldata.Rd
@@ -4,33 +4,43 @@
\alias{build_ldata}
\title{Generate local parameters matrix}
\usage{
-build_ldata(PARCELLE, METEO)
+build_ldata(
+ parcels,
+ meteo,
+ gdata = NULL,
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ mMov = NULL,
+ prev_control = NULL,
+ start_date = NULL,
+ end_date = NULL,
+ nYR_init = 1
+)
}
\arguments{
-\item{PARCELLE}{data.frame or data.table describing the patches. Required columns: "ID": unique identifier, "POP": population size, "SURF_HA": surface in hectare, "KLfix": fix carrying capacity for larvae, "KLvar": variable carrying capacity for larvae, "KPfix": fix carrying capacity for pupae, "KPvar": variable carrying capacity for pupae, "STATION": meteorological station identifier, "DIFF_ALT": difference between meteorological station altitude and average altitude of the patch.}
+\item{parcels}{data.frame or data.table describing the patches. Required columns: 'ID', 'POP', 'Kfix', 'Kvar', 'STATION' (optional), 'DIFF_ALT' (optional).}
-\item{METEO}{data.frame or data.table reporting the daily meteorological data for each meteorological station. Required columns: 'ÌD', 'DATE', 'RR': daily precipitation (mm), 'TP': daily mean temperature (°C)}
+\item{meteo}{data.frame or data.table reporting daily meteorological data. Required columns: 'ID', 'DATE', 'RR', 'TP'.}
-\item{gdata}{list of parameters. Can be generated using `build_gdata` function}
+\item{gdata}{list of parameters, can be generated using `build_gdata` function.}
-\item{vector_species}{string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date. Only needed if gdata is not provided.}
+\item{vector}{string. Default is "Ae. albopictus (D)".}
-\item{mMov}{list of two matrices. Probabilities of location of individuals.
-proba_ij is the probabilities of individuals from i (columns) to be bitten in j (rows).
-proba_ji is the probabilities for mosquito in i (rows) to bite an individual from j (columns).
-Row sums should be equal to 1.}
+\item{virus}{string. Default is "DEN" (dengue virus).}
-\item{start_date}{date in '\%Y-\%m-\%d' format. Starting date of the simulation. If not provided, the function uses the oldest date in the meteorological dataset.}
+\item{mMov}{list of two matrices for movement probabilities. Defaults to NULL, which means no movement.}
-\item{end_date}{date in '\%Y-\%m-\%d' format. Ending date of the simulation. If not provided, the function uses the most recent date in the meteorological dataset.}
+\item{prev_control}{data.frame or data.table describing preventive control measures. Required columns: 'action', 'loc', 'start', 'end', 'p'.}
-\item{nYR_init}{numerical value. Number of years used to initialize the population dynamics (default is 1).}
+\item{start_date}{date in 'Y-m-d' format. Defaults to the earliest date in the meteorological dataset.}
-\item{climat}{string. Default is "Ae. albopictus" in "temperate" climate. Unique dataset implemented to date. Only needed if gdata is not provided.}
+\item{end_date}{date in 'Y-m-d' format. Defaults to the most recent date in the meteorological dataset.}
+
+\item{nYR_init}{numeric. Number of years used to initialize population dynamics. Default is 1.}
}
\value{
-matrix
+matrix of local parameters.
}
\description{
-The function computes and formats for each pacth the list of local parameters required by the model. Arguments related to the simulation are required to compile daily meteorological data for the simulated period.
+The function computes and formats for each patch the list of local parameters required by the model.
}
diff --git a/man/build_mMov.Rd b/man/build_mMov.Rd
index d8f785e74678422c2d728530ef6812d7c20de87f..d3460a9ea0b92d28f451cd91772bbbc16941ec3e 100644
--- a/man/build_mMov.Rd
+++ b/man/build_mMov.Rd
@@ -1,28 +1,46 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/build_mMov_TDLM_based.R
+% Please edit documentation in R/build_mMov.R
\name{build_mMov}
\alias{build_mMov}
\title{Build matrix of contact probabilities}
\usage{
-build_mMov(SpatVec)
+build_mMov(
+ SpatVec,
+ law = "NGravExp",
+ param = NULL,
+ p2move = NULL,
+ outflow = NULL,
+ inflow = NULL,
+ verbose = F
+)
}
\arguments{
\item{SpatVec}{SpatVector or sf. Spatial vector of polygons representing patches. Polygons must include 'POP' and 'ID' attributes.}
-\item{law}{string. Law used to calculate probabilities. Default is "Unif". See documentation of TDLM::run_law function for law options details.}
+\item{law}{string. Law used to calculate probabilities. Default is "NGravExp". See documentation of `TDLM::run_law` function for law options details.}
\item{param}{numeric. Parameter used to adjust the importance of distance or opportunity associated with the chosen law.
A single value or a vector of several parameter values can be used.
-Not necessary for the original radiation law or the uniform law. (see TDLM package for more details)}
+Not necessary for the original radiation law or the uniform law. (see TDLM package for more details)
+Default is NULL. If NULL but required the parameter will be estimated by TDLM package.}
-\item{p2move}{numeric. Probability to be in the residential patch.}
+\item{p2move}{numeric. Optional. Daily probability to move from the residential patch or daily proportion of residents moving from the residential patch. p2move is required if outflow is not provided. If the outflow is provided, the p2move probability is not used.}
-\item{pCom}{numeric. Proportion of cummuters per patch}
+\item{outflow}{numeric. Optional. Average number of person moving out of each patch daily.}
+
+\item{inflow}{numeric. Optional. Average number of person moving in each patch daily.}
+
+\item{verbose}{logical. Display more information during calculation}
}
\value{
-list of normalized matrices for probabilities of contact of agent from patch i with agent of patch j in j (proba_ij) and probabilities of contact of agent from patch j with agent of patch i in i (proba_ji)
+List of mobility metrics:
+
+`mi_mixedpop` is the estimated daily number of persons in each administrative unit (staying residents + visitors).
+
+`proba_ij` is a normalized matrix of probabilities for movements of residents from patch i (rows) in patch j in j (columns) (proba_ij). The referent population is the resident population.
+
+`proba_ji` is a normalized matrix of probabilities for origin i (columns) of agents in patch j (rows) (proba_ji). The referent population is the total population during the day including staying residents and visitors.
}
\description{
-This function creates a synthetic human mobility network.
-You can use this script to generate different input data to be used as examples of "network structures".
+This function estimate probability matrices of movements/trips between all the polygons of a SpatVector or sf object and return them along with other mobility metrics.
}
diff --git a/man/build_mMov_erdosrenyigame.Rd b/man/build_mMov_erdosrenyigame.Rd
deleted file mode 100644
index 38e3d1ab3a7c6863e7b46314d492e9aa24d2bfde..0000000000000000000000000000000000000000
--- a/man/build_mMov_erdosrenyigame.Rd
+++ /dev/null
@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/build_mMov.R
-\name{build_mMov_erdosrenyigame}
-\alias{build_mMov_erdosrenyigame}
-\title{Creates a synthetic network}
-\usage{
-build_mMov()
-}
-\arguments{
-\item{PARCELLE}{data.table}
-
-\item{group}{string}
-
-\item{within_clust_lev}{numeric. Probability of creating links between wards of the same building}
-
-\item{between_clust_lev}{numeric. Probability of creating links between wards of different building}
-
-\item{clust_ratio_inout}{numeric. Ratio of intra-building clustering (relative to inter-building clustering)}
-
-\item{verbose}{logical. Print plot if TRUE}
-}
-\value{
-a matrix with random probabilities of contact
-}
-\description{
-This function creates a synthetic human mobility network.
-You can use this script to generate different input data to be used as examples of "network structures".
-}
diff --git a/man/build_prev_control.Rd b/man/build_prev_control.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..f099e34dcedfe3fd32ada8ee5f0a4480d5778bcc
--- /dev/null
+++ b/man/build_prev_control.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/build_prev_control.R
+\name{build_prev_control}
+\alias{build_prev_control}
+\title{Generate the list of preventive control to implement in the simulation}
+\usage{
+build_prev_control(
+ action,
+ lon,
+ lat,
+ start,
+ end,
+ p,
+ SpatVec,
+ prev_control = NULL,
+ buffer_width = NULL,
+ plot_buffer = F
+)
+}
+\arguments{
+\item{action}{string. 'K': Source reduction (removal or destruction of breeding sites); 'L': Chemical Larviciding; 'A': Fogging or Area Spraying (targets adult mosquitoes)}
+
+\item{lon}{string. longitude of the control location}
+
+\item{lat}{string. latitude of the control location}
+
+\item{start}{date in '\%Y-\%m-\%d' format. Define the beginning of the implemented measure}
+
+\item{end}{date in '\%Y-\%m-\%d' format. Define the end of the implemented measure}
+
+\item{p}{number between 0 and 1. It is for the "K" action: the proportion of sites daily removed during the action ; for the "A" action: the additional daily mortality of adults due to action and for the "L" action: the additional daily mortality of larvae due to larvicide}
+
+\item{SpatVec}{SpatVector or sf. (Required with buffer) Spatial vector of polygons representing patches. Polygons must include 'ID' attribute including the 'loc'.}
+
+\item{prev_control}{data.frame. (optional) prev_control object to build on (add new measures)}
+
+\item{buffer_width}{integer. (optional) Buffer around the location to implement the measure}
+
+\item{plot_buffer}{logical. Display plot of the selected parcels in case of spatial buffer.}
+}
+\value{
+events data.frame with preventive control measures
+}
+\description{
+Function used to generate the preventive control data.frame.
+
+Note that the distance unit of the buffer width parameter is meters if the CRS is (+proj=longlat), and in map units (typically also meters) if not.
+}
+\examples{
+
+f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+SpatVec <- terra::vect(f)
+build_prev_control(action = "K",
+ lon = 1022397, lat = 6321347,
+ start = "2022-01-01", end = "2022-01-05",
+ p = 0.2,
+ SpatVec = SpatVec,
+ buffer_width = 100)
+
+}
+\keyword{events}
diff --git a/man/build_transitions.Rd b/man/build_transitions.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..014f5a0ffccc20fd63cb792d4833e736542f7593
--- /dev/null
+++ b/man/build_transitions.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/build_transitions.R
+\name{build_transitions}
+\alias{build_transitions}
+\title{Write stochatic transitions}
+\usage{
+build_transitions(gdata)
+}
+\arguments{
+\item{gdata}{list of parameters}
+}
+\value{
+String vector describing transitions
+}
+\description{
+Internal function to build the string vector describing stochastic transitions and counters. This vector is required by SimInf package.
+}
+\keyword{internal}
diff --git a/man/configK.Rd b/man/configK.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..7cd3732eaf32b001a3fb73877c684ca8e516a1e2
--- /dev/null
+++ b/man/configK.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{configK}
+\alias{configK}
+\title{Carrying capacity estimates per land cover type}
+\format{
+data frame with columns:
+\describe{
+ \item{ID}{...}
+}
+}
+\source{
+mtd
+}
+\description{
+Carrying capacity estimates per land cover type
+}
+\keyword{data}
diff --git a/man/estim_K.Rd b/man/estim_K.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..407f8ed264530a8e959df903dcb7af48d2cdabd9
--- /dev/null
+++ b/man/estim_K.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/estim_K.R
+\name{estim_K}
+\alias{estim_K}
+\title{Estimate spatial carrying capacities}
+\usage{
+estim_K(PARCELS_SHAPE, URBAN_ATLAS = NULL)
+}
+\arguments{
+\item{PARCELS_SHAPE}{SpatVector object with polygons of parcels}
+
+\item{URBAN_ATLAS}{SpatVector object or list of SpatVector objects with polygons of soil occupation class by urban atlas}
+}
+\value{
+SpatVector object
+}
+\description{
+Function used to estimate carrying capacity from soil occupation classes
+}
+\examples{
+\dontrun{
+PARCELS_SHAPE <- system.file("shape/SpatVec.shp", package = "arbocartoR") \%>\% vect
+PARCELS_SHAPE_K_ESTIM <- estim_K(PARCELS_SHAPE, URBAN_ATLAS)
+}
+
+}
+\keyword{capacity}
+\keyword{carrying}
diff --git a/man/filter_meteo.Rd b/man/filter_meteo.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..c21940db9a82691bded85b4e972035a603c43db3
--- /dev/null
+++ b/man/filter_meteo.Rd
@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/filter_meteo.R
+\name{filter_meteo}
+\alias{filter_meteo}
+\title{Filter Meteorological Data}
+\usage{
+filter_meteo(parcels, meteo, TS_sim)
+}
+\arguments{
+\item{parcels}{data.table with parcel information, including a column `ID` or `STATION`.}
+
+\item{meteo}{data.table with meteorological data, including columns `ID` and `DATE`.}
+
+\item{TS_sim}{list containing a vector `time_serie_date` of dates to be retained.}
+}
+\value{
+data.table with filtered meteorological data.
+}
+\description{
+Filters meteorological data to retain only the rows corresponding to parcel IDs present in `parcels` and dates present in `TS_sim$time_serie_date`.
+}
+\details{
+This function ensures that the meteorological data contains only the IDs found in `parcels` and that there are records for all dates in `TS_sim$time_serie_date`.
+}
+\examples{
+# Example usage:
+parcels <- data.table(ID = 1:3, STATION = c('A', 'B', 'C'))
+meteo <- data.table(ID = c('A', 'B', 'C'), DATE = as.Date('2023-01-01') + 0:2)
+TS_sim <- list(time_serie_date = as.Date('2023-01-01') + 0:2)
+filter_meteo(parcels, meteo, TS_sim)
+
+}
+\keyword{filter}
+\keyword{meteo}
diff --git a/man/iniState.Rd b/man/iniState.Rd
index f852b9a56a33927bdae477747ab0e043cf7e4533..268385f58153fafbf628a662afac34ac99ce8427 100644
--- a/man/iniState.Rd
+++ b/man/iniState.Rd
@@ -4,15 +4,35 @@
\alias{iniState}
\title{Write initial state of the meta-population}
\usage{
-iniState(PARCELLE)
+iniState(parcels, diapause = FALSE, initMosq = 100000)
}
\arguments{
-\item{PARCELLE}{data.frame or data.table}
+\item{parcels}{data.frame or data.table}
+
+\item{diapause}{logical}
\item{initMosq}{numerical value Initial number of eggs in each node.}
}
\value{
-list
+list with two data.frame: u0 and v0
+
+u0 is the initial population stage for each compartment in each parcel. Each row describe a patch and in columns:
+ "Sh": susceptible humans ; "Eh": exposed humans ; "Ih": infectious humans ;"Rh": recovered humans ;
+ "A1gmE", "A1omE", "A2hmE", "A2gmE", "A2omE": exposed stages for adult mosquitoes (see details of stages below)
+ "A1gmI" "A1omI" "A2hmI" "A2gmI" "A2omI": infectious stages for adult mosquitoes (see details of stages below)
+ "Neggs": number of eggs layed by infected mosquitoes
+ "ninfhL": number of local human autochtonous infection
+ "ninfhE": number of external human autochtonous infection
+ "ninfm1": number of nulliparous mosquitoes autochtonous infection
+ "ninfm2": number of parous mosquitoes autochtonous infection
+
+v0 is the initial population and time-dependant parameters state. Each columns describe a patch and in rows:
+z: diapause (0 = dipause, 1 = favorable period); temperature; kL and kP: carrying capacities for larvae and pupae (rainfall dependent);
+Em: number of eggs ; Lm: number of larvae ; Pm: number of pupae ; Aemm: number of emerging adults ;
+A1hm: number of nulliparous adults seeking for host ; A1gm: number of gorged nulliparous adults ; A1om: number of nulliparous adults seeking for oviposition sites ;
+A2hm: number of parous adults seeking for host ; A2gm: number of gorged parous adults ; A1om: number of parous adults seeking for oviposition sites ;
+prevEggs, nIm1, nIm2, R0, betaHext and betaMext are continous variables calculated over time)
+newEggs: daily number of new layed eggs
}
\description{
initialize
diff --git a/man/meteo.Rd b/man/meteo.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..cab15631296b2b898f736a1a28b7aa98cff3d9fe
--- /dev/null
+++ b/man/meteo.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{meteo}
+\alias{meteo}
+\title{Meteorological data}
+\format{
+data frame with columns:
+\describe{
+ \item{ID}{unique identifier per meteorological station}
+ \item{DATE}{date of the meteorological record}
+ \item{RR}{Daily precipitation/rainfall (in mm)}
+ \item{TP}{DAily average temperature (in degree)}
+}
+}
+\source{
+meteofrance
+}
+\description{
+Meteorological data
+}
+\keyword{data}
diff --git a/man/parcels.Rd b/man/parcels.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..ce26cf0d40f0af0558fb313b34dfcdcad83eef4e
--- /dev/null
+++ b/man/parcels.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{parcels}
+\alias{parcels}
+\title{Parcelle data}
+\format{
+data frame with columns:
+\describe{
+ \item{ID}{unique identifier for each parcel}
+ \item{NOM_COM}{Name of the city associated to the parcel}
+ \item{SURF_HA}{surface in hectare (optional)}
+ \item{STATION}{unique identifier of the meteorological station associated to the parcel (optional)}
+ \item{DIFF_ALT}{difference between average altitude of the parcel and the altitude of the associated meteorological station (optional)}
+ \item{ALT}{average altitude of the parcel (optional)}
+ \item{Kfix}{Fix carrying capacity (number of larvae in anthropic breeding sites)}
+ \item{Kvar}{Varying carrying capacity (number of larvae in natural breeding sites)}
+ \item{POP}{Human population size}
+}
+}
+\source{
+iris-ge, urban atlas, CLC
+}
+\description{
+Parcelle data
+}
+\keyword{data}
diff --git a/man/plot_TS.Rd b/man/plot_TS.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..72e64ac963a1368eecb9a52905ac72223d914071
--- /dev/null
+++ b/man/plot_TS.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plot_TS.R
+\name{plot_TS}
+\alias{plot_TS}
+\title{Plot trajectories of the first simulation}
+\usage{
+plot_TS(traj, stage, parcels_ids = NULL, simulation = 1)
+}
+\arguments{
+\item{traj}{output of a run_arbocartoR simulation}
+
+\item{stage}{String vector. Epidemiological or biological stages to visualize (see colnames of traj).}
+
+\item{parcels_ids}{String vector. Patch ids to visualize (must match with ID column in traj objects).}
+
+\item{simulation}{Numerical vector. Considered simulation (must be <= to the length of traj).}
+}
+\value{
+dygraphs plot
+}
+\description{
+Function used to plot the trajectories of any compartments (median and 95% interval over all the selected parcels and simulation).
+}
+\examples{
+
+\dontrun{
+data(parcels)
+data(meteo)
+
+parcels <- parcels[startsWith(ID, "06"),]
+
+traj <- run_arbocartoR(parcels = parcels,
+ vector = "Ae. albopictus",
+ virus = "DEN",
+ meteo = meteo)
+
+plot_TS(traj, stage = c("Em", "Lm", "Pm"), parcels_ids = NULL, simulation = 1)
+}
+
+}
+\keyword{plot}
+\keyword{trajectories}
+\keyword{visualization}
diff --git a/man/reexports.Rd b/man/reexports.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..b90cb1b76ca64ead0d5cf8a3a14c4e043a2a160f
--- /dev/null
+++ b/man/reexports.Rd
@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pipe.R
+\docType{import}
+\name{reexports}
+\alias{reexports}
+\alias{\%>\%}
+\title{Objects exported from other packages}
+\keyword{internal}
+\description{
+These objects are imported from other packages. Follow the links
+below to see their documentation.
+
+\describe{
+ \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}}
+}}
+
diff --git a/man/runArboRisk.Rd b/man/runArboRisk.Rd
deleted file mode 100644
index 14b9780cdad59abe8767918e97464e92cb48bfb3..0000000000000000000000000000000000000000
--- a/man/runArboRisk.Rd
+++ /dev/null
@@ -1,46 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/runArboRisk.R
-\name{runArboRisk}
-\alias{runArboRisk}
-\title{Run a simulation}
-\usage{
-runArboRisk(PARCELLE, METEO, gdata, mMov = NULL, start_date, end_date, nYR_init = 2, nodeID = "ID")
-}
-\arguments{
-\item{PARCELLE}{data.frame or data.table}
-
-\item{vector_species}{string}
-
-\item{gdata}{list}
-
-\item{METEO}{data.frame or data.table}
-
-\item{mMov}{double matrix}
-
-\item{start_date}{date in '\%Y-\%m-\%d' format}
-
-\item{end_date}{date in '\%Y-\%m-\%d' format}
-
-\item{nYR_init}{numeric. Number of years used to initialize the population dynamics (default is 1)}
-
-\item{n_sim}{integer}
-
-\item{introduction_pts}{data.frame or data.table}
-
-\item{u0}{matrix Initial population state (patches as columns and in rows: Sh, Eh, Ih, Rh, A1gmI, A1omI, A2hmI, A2gmI, A2omI, Neggs, ninfh, ninfm1, ninfm2)}
-
-\item{v0}{matrix Initial population and time-dependant parameters state (patches as rows and in columns:
-z: diapause (0 = dipause, 1 = favorable period); temperature; kL and kP: carrying capacities for larvae and pupae (rainfall dependent);
-Em: number of eggs ; Lm: number of larvae ; Pm: number of pupae ; Aemm: number of emerging adults ;
-A1hm: number of nulliparous adults seeking for host ; A1gm: number of gorged nulliparous adults ; A1om: number of nulliparous adults seeking for oviposition sites ;
-A2hm: number of parous adults seeking for host ; A2gm: number of gorged parous adults ; A1om: number of parous adults seeking for oviposition sites ;
-prevEggs, nIm1, nIm2, R0, pIh and pIm are continous variables calculated over time)}
-
-\item{initMosq}{numeric. Number of eggs in each patch at t0 (default is 100000).}
-}
-\value{
-data.table
-}
-\description{
-function to run simulations
-}
diff --git a/man/run_arbocartoR.Rd b/man/run_arbocartoR.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..cd93bed278498fff78c5c84612b5a9c33b1dc7c6
--- /dev/null
+++ b/man/run_arbocartoR.Rd
@@ -0,0 +1,75 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/run_arbocartoR.R
+\name{run_arbocartoR}
+\alias{run_arbocartoR}
+\title{Run a simulation}
+\usage{
+run_arbocartoR(
+ parcels,
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ gdata = NULL,
+ ldata = NULL,
+ meteo = NULL,
+ mMov = NULL,
+ start_date = NULL,
+ end_date = NULL,
+ nYR_init = 1,
+ n_sim = 1,
+ introduction_pts = NULL,
+ prev_control = NULL,
+ u0 = NULL,
+ v0 = NULL,
+ initMosq = 1e+05,
+ verbose = F
+)
+}
+\arguments{
+\item{parcels}{data.frame or data.table describing the patches. Required columns: 'ID': unique identifier, 'POP': population size, 'Kfix': fix carrying capacity for larvae and pupae, 'Kvar': variable carrying capacity for larvae and pupae, 'STATION': meteorological station identifier (optional), 'DIFF_ALT': difference between meteorological station altitude and average altitude of the patch (optional).}
+
+\item{vector}{string. "Ae. albopictus", "Ae. albopictus (D)" or "Ae. aegypti". Default is "Ae. albopictus".}
+
+\item{virus}{string. "DEN" (dengue), "ZIK" (zika) or "CHI" (chikungunya). Default is "DEN" (dengue) virus.}
+
+\item{gdata}{list of parameters. Can be generated using `build_gdata` function.}
+
+\item{ldata}{matrix of local data}
+
+\item{meteo}{data.frame or data.table reporting the daily meteorological data for each meteorological station. Required columns: 'ID', 'DATE', 'RR': daily precipitation (mm), 'TP': daily mean temperature (degrees)}
+
+\item{mMov}{double matrix}
+
+\item{start_date}{date in '\%Y-\%m-\%d' format}
+
+\item{end_date}{date in '\%Y-\%m-\%d' format}
+
+\item{nYR_init}{numeric. Number of years used to initialize the population dynamics (default is 1)}
+
+\item{n_sim}{integer}
+
+\item{introduction_pts}{data.frame or data.table describing the introduction of individuals. Can be generated by [build_E_random()] function (see function documentation for additional details on the structure.}
+
+\item{prev_control}{data.frame or data.table describing preventive control measure implemented. Required columns: 'action', 'loc', 'start', 'end', 'p' (see details)}
+
+\item{u0}{data.frame describing the initial population stage for each compartment in each parcel. Can be generated by [iniState()] function (see documentation of the function for more details on the structure).}
+
+\item{v0}{data.frame describing the initial population and time-dependant parameters state. Can be generated by [iniState()] function (see documentation of the function for more details on the structure).}
+
+\item{initMosq}{numeric. Number of eggs in each patch at t0 (default is 100000).
+
+ @details
+ Preventive control content:
+ 'action' column must be strings 'K', 'L' or 'A'. 'K': Source reduction (removal or destruction of breeding sites); 'L': Chemical Larviciding; 'A': Fogging or Area Spraying (targets adult mosquitoes)
+ 'loc' column must be a parcel id
+ 'start' is the first day of implementation of the measure
+ 'end' is the last day of implementation of the measure (the control is implemented every day in between)
+ 'p' must be a number between 0 and 1. It is for the "K" action: the proportion of sites daily removed during the action ; for the "A" action: the additional daily mortality of adults due to action and for the "L" action: the additional daily mortality of larvae due to larvicide}
+
+\item{verbose}{logical. Provide additional information during process}
+}
+\value{
+data.table
+}
+\description{
+function to run simulations
+}
diff --git a/tests/testthat.R b/tests/testthat.R
index 79b6b99567223433766f8cb7c02b31071f879afd..3f51ad41e4c0ef51e72ac175885a8abee5789e35 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -7,6 +7,6 @@
# * https://testthat.r-lib.org/reference/test_package.html#special-files
library(testthat)
-library(ArboRisk)
+library(arbocartoR)
-test_check("ArboRisk")
+test_check("arbocartoR")
diff --git a/tests/testthat/test-build_E_random.R b/tests/testthat/test-build_E_random.R
new file mode 100644
index 0000000000000000000000000000000000000000..ff76a87ef946e6522e5bd9ec654bd3850d5c88b2
--- /dev/null
+++ b/tests/testthat/test-build_E_random.R
@@ -0,0 +1,90 @@
+test_that("introduction", {
+
+ E <- build_E_random(
+ period_start = as.Date("2020/03/10"),
+ period_end = as.Date("2020/09/30"),
+ n_ind = NULL,
+ n_events = 10,
+ stage = "Eh",
+ loc = LETTERS[1:3])
+
+ E %>%
+ expect_type("list") %>%
+ expect_s3_class("data.frame") %>%
+ expect_length(4)
+
+ expect_contains(names(E),
+ c("time","dest","n","select"))
+
+ expect_equal(nrow(E), 10)
+
+ expect_s3_class(E$time, "Date")
+ expect_s3_class(E$dest, "factor")
+ expect_true(inherits(E$n, c("numeric", 'integer')))
+ expect_s3_class(E$select, "factor")
+
+ ##
+
+ E <- build_E_random(
+ period_start = as.Date("2020/03/10"),
+ period_end = as.Date("2020/09/30"),
+ n_ind = 50,
+ n_events = NULL,
+ stage = "Eh",
+ loc = LETTERS[1:3])
+
+ E %>%
+ expect_type("list") %>%
+ expect_s3_class("data.frame") %>%
+ expect_length(4)
+
+ expect_contains(names(E),
+ c("time","dest","n","select"))
+
+
+ expect_equal(sum(E$n), 50)
+
+ expect_s3_class(E$time, "Date")
+ expect_s3_class(E$dest, "factor")
+ expect_true(inherits(E$n, c("numeric", 'integer')))
+ expect_s3_class(E$select, "factor")
+
+ ###
+ E <- build_E_random(
+ period_start = as.Date("2020/03/10"),
+ period_end = as.Date("2020/09/30"),
+ n_ind = 50,
+ n_events = 12,
+ stage = "Eh",
+ loc = LETTERS[1:3])
+
+ E %>%
+ expect_type("list") %>%
+ expect_s3_class("data.frame") %>%
+ expect_length(4)
+
+ expect_contains(names(E),
+ c("time","dest","n","select"))
+
+
+ expect_equal(nrow(E), 12)
+ expect_equal(sum(E$n), 50)
+
+ expect_s3_class(E$time, "Date")
+ expect_s3_class(E$dest, "factor")
+ expect_true(inherits(E$n, c("numeric", 'integer')))
+ expect_s3_class(E$select, "factor")
+
+
+ introduction_pts <- build_E_random(
+ period_start <- "2020/03/10" %>% as.Date,
+ period_end <- "2020/09/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = letters[1:5])
+
+ expect_equal(dim(introduction_pts), c(5,4))
+ expect_equal(names(introduction_pts), c("time", "dest", "n", "select"))
+
+})
diff --git a/tests/testthat/test-build_gdata.R b/tests/testthat/test-build_gdata.R
new file mode 100644
index 0000000000000000000000000000000000000000..d8949d24ce974f8c7a54a61dc8ba7fa9eb7f3f40
--- /dev/null
+++ b/tests/testthat/test-build_gdata.R
@@ -0,0 +1,53 @@
+test_that("albopictus", {
+
+ gdata <- build_gdata(
+ vector = "Ae. albopictus (D)")
+
+ expect_type(gdata, "list")
+ expect_length(gdata, 38)
+
+ gdata <- build_gdata(
+ vector = "Ae. albopictus")
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 36)
+
+
+ gdata <- build_gdata(
+ vector = "Ae. albopictus",
+ virus = 'CHI')
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 36)
+
+ gdata <- build_gdata(
+ vector = "Ae. albopictus",
+ virus = 'ZIK')
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 36)
+ })
+
+test_that("aegypti", {
+
+ gdata <- build_gdata(
+ vector = "Ae. aegypti")
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 50)
+
+ gdata <- build_gdata(
+ vector = "Ae. aegypti",
+ virus = 'CHI')
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 50)
+
+ gdata <- build_gdata(
+ vector = "Ae. aegypti",
+ virus = 'ZIK')
+
+ expect_true(inherits(gdata, "list"))
+ expect_length(gdata, 50)
+
+})
diff --git a/tests/testthat/test-build_ldata.R b/tests/testthat/test-build_ldata.R
new file mode 100644
index 0000000000000000000000000000000000000000..856a90d37c3a06f8340e00724a03414ed0f1a6e0
--- /dev/null
+++ b/tests/testthat/test-build_ldata.R
@@ -0,0 +1,19 @@
+test_that("build_ldata", {
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ gdata = NULL,
+ vector = "Ae. aegypti",
+ virus = 'ZIK',
+ mMov = NULL,
+ prev_control = NULL,
+ start_date = NULL,
+ end_date = NULL,
+ nYR_init = 1)
+
+ expect_equal(inherits(ldata, 'matrix'),T)
+ expect_equal(ncol(ldata), nrow(parcels))
+
+})
diff --git a/tests/testthat/test-build_mMov.R b/tests/testthat/test-build_mMov.R
new file mode 100644
index 0000000000000000000000000000000000000000..243c20cfc1f42f3ff3bcd527df048a94ded21c11
--- /dev/null
+++ b/tests/testthat/test-build_mMov.R
@@ -0,0 +1,32 @@
+test_that("build movement matrix", {
+
+ f <- system.file("shape/SpatVec.shp", package="arbocartoR")
+ SpatVec <- terra::vect(f) %>% .[1:4,]
+
+ for(law in c("GravExp", "NGravExp","GravPow","NGravPow", "Schneider","Rad", "RadExt", "Unif")){
+
+ if(!law %in% c("GravExp", "GravPow"))
+ param = NULL else param = 0.01
+
+ mMov <- build_mMov(SpatVec,
+ law = law,
+ param = param,
+ p2move = 0.7,
+ outflow = NULL,
+ inflow = NULL,
+ verbose = F)
+
+ expect_true(inherits(mMov, 'list'))
+ expect_true(inherits(mMov$proba_ij, 'matrix'))
+ expect_true(inherits(mMov$proba_ji, 'matrix'))
+ expect_equal(dim(mMov$proba_ij), dim(mMov$proba_ji))
+
+ expect_false(TRUE %in% is.na(mMov$proba_ij))
+ expect_false(TRUE %in% is.na(mMov$proba_ji))
+
+ expect_true(
+ round(sum(mMov$proba_ij * SpatVec$POP)) == round(sum(mMov$proba_ji * mMov$mi_mixedpop))
+ )
+ }
+
+})
diff --git a/tests/testthat/test-estim_K.R b/tests/testthat/test-estim_K.R
new file mode 100644
index 0000000000000000000000000000000000000000..6ff554f244880372c0c235965eacfa8570e32259
--- /dev/null
+++ b/tests/testthat/test-estim_K.R
@@ -0,0 +1,14 @@
+test_that("estim_K", {
+
+ ## LOAD STUDY AREA SPATIAL DIVISION
+
+ PARCELS_SHAPE <- system.file("shape/SpatVec.shp", package = "arbocartoR") %>% terra::vect(.)
+
+ ## LOAD URBAN ATLAS
+
+ PARCELS_SHAPE_estimated <- estim_K(PARCELS_SHAPE)
+
+ expect_true(inherits(PARCELS_SHAPE_estimated, "SpatVector"))
+ expect_contains(names(PARCELS_SHAPE_estimated), c("Kfix", "Kvar"))
+
+})
diff --git a/tests/testthat/test-plot_TS.R b/tests/testthat/test-plot_TS.R
new file mode 100644
index 0000000000000000000000000000000000000000..8e5b88006a8c5dfa2fe3942ddb1e7c25a1a1dc11
--- /dev/null
+++ b/tests/testthat/test-plot_TS.R
@@ -0,0 +1,36 @@
+test_that("multiplication works", {
+ data(parcels)
+ data(meteo)
+
+ parcels %<>% .[startsWith(ID, "06"),]
+ parcels %<>% .[ID %in% unique(parcels$ID)[1:4],]
+
+ traj <- run_arbocartoR(parcels = parcels,
+ vector = "Ae. albopictus (D)",
+ virus = "DEN",
+ meteo = meteo,
+ n_sim = 2)
+
+ p <- plot_TS(traj,
+ stage = c("Em", "Lm", "Pm"),
+ parcels_ids = NULL,
+ simulation = 1)
+
+ expect_s3_class(p, "dygraphs")
+
+ p <- plot_TS(traj,
+ stage = c("Em", "Lm", "Pm"),
+ parcels_ids = parcels$ID[1],
+ simulation = 1)
+
+ expect_s3_class(p, "dygraphs")
+
+
+ p <- plot_TS(traj,
+ stage = c("Em", "Lm", "Pm"),
+ parcels_ids = parcels$ID[1],
+ simulation = 1:2)
+
+ expect_s3_class(p, "dygraphs")
+
+})
diff --git a/tests/testthat/test-runArboRisk.R b/tests/testthat/test-runArboRisk.R
deleted file mode 100644
index 8e96ef6c802cd655ec2ba1916c4368781f078e77..0000000000000000000000000000000000000000
--- a/tests/testthat/test-runArboRisk.R
+++ /dev/null
@@ -1,76 +0,0 @@
-test_that("simulation works", {
-
- PARCELLE %<>% .[startsWith(PARCELLE$ID, "34"),]
-
- traj <- runArboRisk(PARCELLE = PARCELLE,
- METEO = METEO,
- n_sim = 2)
-
- expect_type(traj, "list")
- expect_s3_class(traj[[1]], "data.frame")
- expect_length(traj, 2)
-
-})
-
-test_that("simulation works with introduction", {
-
- PARCELLE %<>% .[startsWith(PARCELLE$ID, "34"),]
-
- introduction_pts <- build_E_random(
- period_start <- "2022/08/10" %>% as.Date,
- period_end <- "2022/08/30" %>% as.Date,
- n_ind = 1:10,
- n_events = 5,
- stage = "Eh",
- loc = PARCELLE$ID[1])
-
- traj <- runArboRisk(PARCELLE = PARCELLE,
- METEO = METEO,
- n_sim = 2,
- introduction_pts = introduction_pts)
-
- expect_type(traj, "list")
- expect_s3_class(traj[[1]], "data.frame")
- expect_length(traj, 2)
-
-})
-
-
-test_that("simulation works with introduction and human mobility", {
-
- f <- system.file("data/SpatVec.shp", package="ArboRisk")
- SpatVec <- terra::vect(f)
-
-PARCELLE %<>% .[startsWith(PARCELLE$ID, "34"),]
-SpatVec <- SpatVec[SpatVec$ID %in% PARCELLE$ID, ]
-
- introduction_pts <- build_E_random(
- period_start <- "2022/08/10" %>% as.Date,
- period_end <- "2022/08/30" %>% as.Date,
- n_ind = 1:10,
- n_events = 5,
- stage = "Eh",
- loc = PARCELLE$ID[1])
-
-mMov <- build_mMov(SpatVec,
- law = "GravExp",
- param = 0.00001,
- p2move = 0.9,
- pCom = 0.7)
-
-ldata <- build_ldata(PARCELLE,
- METEO,
- mMov = mMov)
-
-traj <- runArboRisk(PARCELLE = PARCELLE,
- ldata = ldata,
- n_sim = 2,
- start_date = min(METEO$DATE) %>% as.Date,
- end_date = max(METEO$DATE) %>% as.Date,
- introduction_pts = introduction_pts)
-
- expect_type(traj, "list")
- expect_s3_class(traj[[1]], "data.frame")
- expect_length(traj, 2)
-
-})
diff --git a/tests/testthat/test-run_arbocartoR.R b/tests/testthat/test-run_arbocartoR.R
new file mode 100644
index 0000000000000000000000000000000000000000..7580f967f2358e76fa41e7edee6daea327668dea
--- /dev/null
+++ b/tests/testthat/test-run_arbocartoR.R
@@ -0,0 +1,159 @@
+test_that("simulation works", {
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ traj <- run_arbocartoR(parcels = parcels,
+ meteo = meteo,
+ n_sim = 2)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+})
+
+test_that("simulation works with introduction", {
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = 155,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ traj <- run_arbocartoR(parcels = parcels,
+ meteo = meteo,
+ n_sim = 2,
+ introduction_pts = introduction_pts)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+
+})
+
+
+test_that("simulation works with introduction and human mobility", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ mMov = mMov)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+
+})
+
+
+test_that("simulation works with introduction, human mobility and preventive control", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ prev_control <- data.table(
+ action = character(),
+ loc = factor(),
+ start = structure(numeric(0), class = "Date"),
+ end = structure(numeric(0), class = "Date"),
+ p = numeric()
+ )
+
+ # action : 'K': destruction of breeding sites, 'L': larviciding, "A": adulticiding
+
+ prev_control %<>% list(prev_control, data.table(
+ action = "K",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ ## add prev_control action: increase the larvae mortality (larviciding)
+ prev_control %<>% list(prev_control, data.table(
+ action = "L",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ prev_control %<>% list(prev_control, data.table(
+ action = "L",
+ loc = "061220000",
+ start = as.Date("2022/07/07"),
+ end = as.Date("2022/07/15"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ ## add prev_control action: increase the mosquito adult mortality (fumigation)
+ prev_control %<>% list(prev_control, data.table(
+ action = "A",
+ loc = "060640000",
+ start = as.Date("2022/08/01"),
+ end = as.Date("2022/08/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ prev_control %<>% unique
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ mMov = mMov,
+ prev_control = prev_control)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts,
+ prev_control = prev_control)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+
+})
+
diff --git a/tests/testthat/test-test_intro.R b/tests/testthat/test-test_intro.R
deleted file mode 100644
index 2a90eb418a6b9468c5b6bc8056e815825ee97f38..0000000000000000000000000000000000000000
--- a/tests/testthat/test-test_intro.R
+++ /dev/null
@@ -1,11 +0,0 @@
-test_that("introduction works", {
- introduction_pts <- build_E_random(
- period_start <- "2020/03/10" %>% as.Date,
- period_end <- "2020/09/30" %>% as.Date,
- n_ind = 1:10,
- n_events = 5,
- stage = "Eh",
- loc = letters[1:5])
- expect_equal(dim(introduction_pts), c(5,4))
- expect_equal(names(introduction_pts), c("time", "dest", "n", "select"))
-})
diff --git a/tests/testthat/test-test_species.R b/tests/testthat/test-test_species.R
new file mode 100644
index 0000000000000000000000000000000000000000..7387d80729119c08ca5dcb09fad7f410db018bc9
--- /dev/null
+++ b/tests/testthat/test-test_species.R
@@ -0,0 +1,102 @@
+test_that("simulations with aegypti", {
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ traj <- run_arbocartoR(parcels = parcels,
+ vector = "Ae. aegypti",
+ meteo = meteo,
+ n_sim = 2,
+ verbose = F)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+
+})
+
+
+test_that("simulation works with introduction, human mobility and preventive control", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ prev_control <- data.table(
+ action = character(),
+ loc = factor(),
+ start = structure(numeric(0), class = "Date"),
+ end = structure(numeric(0), class = "Date"),
+ p = numeric()
+ )
+
+ # action : 'K': destruction of breeding sites, 'L': larviciding, "A": adulticiding
+
+ prev_control %<>% list(prev_control, data.table(
+ action = "K",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ ## add prev_control action: increase the larvae mortality (larviciding)
+ prev_control %<>% list(prev_control, data.table(
+ action = "L",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ prev_control %<>% list(prev_control, data.table(
+ action = "L",
+ loc = "061220000",
+ start = as.Date("2022/07/07"),
+ end = as.Date("2022/07/15"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ ## add prev_control action: increase the mosquito adult mortality (fumigation)
+ prev_control %<>% list(prev_control, data.table(
+ action = "A",
+ loc = "060640000",
+ start = as.Date("2022/08/01"),
+ end = as.Date("2022/08/07"),
+ p = 0.5)) %>% data.table::rbindlist(fill = TRUE)
+
+ prev_control %<>% unique
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ vector = "Ae. aegypti",
+ mMov = mMov,
+ prev_control = prev_control)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ vector = "Ae. aegypti",
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts,
+ prev_control = prev_control,
+ verbose = F)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+
+})
diff --git a/tests/testthat/test-viruses.R b/tests/testthat/test-viruses.R
new file mode 100644
index 0000000000000000000000000000000000000000..adbdda1f10fa8ee9a6b1551b38c332e11b4c6b1d
--- /dev/null
+++ b/tests/testthat/test-viruses.R
@@ -0,0 +1,128 @@
+
+
+test_that("ZIKA", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ vector = "Ae. albopictus (D)",
+ virus = 'ZIK',
+ mMov = mMov)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ vector = "Ae. albopictus (D)",
+ virus = 'ZIK',
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+})
+
+test_that("DENGUE", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ vector = "Ae. albopictus (D)",
+ virus = 'DEN',
+ mMov = mMov)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ vector = "Ae. albopictus (D)",
+ virus = 'DEN',
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+})
+
+
+test_that("CHIKUNGUNYA", {
+
+ f <- system.file("shape/SpatVec.shp", package = "arbocartoR")
+ SpatVec <- terra::vect(f)
+
+ parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+
+ SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+ introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+ mMov <- build_mMov(SpatVec,
+ law = "GravExp",
+ param = 0.00001,
+ p2move = 0.9)
+
+ ldata <- build_ldata(parcels,
+ meteo,
+ vector = "Ae. albopictus (D)",
+ virus = 'CHI',
+ mMov = mMov)
+
+ traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ vector = "Ae. albopictus (D)",
+ virus = 'CHI',
+ n_sim = 2,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ introduction_pts = introduction_pts)
+
+ expect_type(traj, "list")
+ expect_s3_class(traj[[1]], "data.frame")
+ expect_length(traj, 2)
+})
diff --git a/vignettes/R0_computations.Rmd b/vignettes/R0_computations.Rmd
new file mode 100644
index 0000000000000000000000000000000000000000..f97a4fe3886242a54fb07de0bd66b2be6d1dd4c0
--- /dev/null
+++ b/vignettes/R0_computations.Rmd
@@ -0,0 +1,171 @@
+---
+title: "Explore R0 computations"
+output: rmarkdown::html_vignette
+date: "`r Sys.Date()`"
+vignette: >
+ %\VignetteIndexEntry{Explore R0 computations}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>"
+)
+```
+
+### Initialization
+
+```{r setup}
+
+# install if not already done:
+# remotes::install_gitlab("umr-astre/arbocartoR", host = "https://forgemia.inra.fr")
+
+suppressPackageStartupMessages({
+ suppressWarnings({
+library(arbocartoR)
+library(matlib)
+library(fastmatrix)
+ })
+})
+```
+
+### Create matrices and calculate R0 on the basis of doi:10.1098/rsif.2009.0386
+
+```{r}
+
+# Select 4 parcels
+parcels %<>% .[grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM),]
+
+# build global data
+gdata = build_gdata()
+
+# define introductions
+introduction_pts <- build_E_random(
+ period_start <- "2022/08/10" %>% as.Date,
+ period_end <- "2022/08/30" %>% as.Date,
+ n_ind = NULL,
+ n_events = 5,
+ stage = "Eh",
+ loc = parcels$ID[1])
+
+# run 1 simulations
+traj <- run_arbocartoR(parcels = parcels,
+ meteo = meteo,
+ gdata = gdata,
+ n_sim = 1,
+ introduction_pts = introduction_pts)
+
+# initialize R0 and loop
+R0 = 0
+i = 0
+
+# select on population one day
+epi_states_t <- c("A1gmE", "A1omE", "A2hmE", "A2gmE", "A2omE","A1gmI", "A1omI", "A2hmI", "A2gmI", "A2omI", "Eh", "Ih")
+# simplify names for Andrea
+epi_states_t_simplier <- c(paste0("E", 1:5), paste0("I", 1:5), "Eh", "Ih")
+
+# while R0 > 0
+while(R0 == 0 & i < nrow(traj[[1]][A1hm >0 & A2hm >0 & time > 1 & G2O > 0,])){
+ i <<- i + 1
+
+ # select on population one day
+t <- traj[[1]][A1hm >0 & A2hm >0 & time > 1 & G2O > 0,][i,]
+
+# number of nulliparous mosquitoes looking for host
+MA1h <- t[,A1hm]
+# number of pareous mosquitoes looking for host
+MA2h <- t[,A2hm]
+# population size
+NH <- t[,sum(Sh, Eh, Ih)]
+# duration of extrinsec exposed stage
+deltaE2I <- t[,E2I]
+# daily transition rate from gorged to ovisposition site seeking
+gammaAg <- t[,G2O]
+# daily mortality rate for adult mosquitoes
+muA <- max(gdata$mu3A, gdata$mu1A * exp((t[,temperature] - 10) * gdata$mu2A) + gdata$mu3A)
+# daily mortality rate for adult mosquitoes looking for something (host or ovisposition site)
+muAr <- muA + gdata$muR
+
+# matrix T (mat_T) is the transmission part, describing the production of new infections
+mat_T = matrix(0, ncol = 12, nrow = 12)
+
+rownames(mat_T) <- colnames(mat_T) <- epi_states_t_simplier
+
+mat_T[1,12] <- (gdata$bHM*MA1h*gdata$gammaAh)/NH
+mat_T[4,12] <- (gdata$bHM*MA2h*gdata$gammaAh)/NH
+mat_T[11,8] <- gdata$bMH*gdata$gammaAh
+
+# matrix sigma (mat_sigma) is the transition part, describing changes in state (including removal by death or the acquisition of immunity)
+mat_sigma = matrix(0, ncol = 12, nrow = 12)
+
+rownames(mat_sigma) <- colnames(mat_sigma) <- epi_states_t_simplier
+
+mat_sigma[1,1] <- -(gammaAg+muA+1/deltaE2I)
+mat_sigma[2,1] <- gammaAg
+mat_sigma[6,1] <- 1/deltaE2I
+
+mat_sigma[2,2] <- -(gdata$gammaAo+muAr+1/deltaE2I)
+mat_sigma[3,2] <- gdata$gammaAo
+mat_sigma[7,2] <- 1/deltaE2I
+
+mat_sigma[3,3] <- -(gdata$gammaAh+muAr+1/deltaE2I)
+mat_sigma[4,3] <- gdata$gammaAo
+mat_sigma[8,3] <- 1/deltaE2I
+
+mat_sigma[4,4] <- -(gammaAg+muA+1/deltaE2I)
+mat_sigma[5,4] <- gammaAg
+mat_sigma[9,4] <- 1/deltaE2I
+
+mat_sigma[5,5] <- -(gdata$gammaAo+muAr+1/deltaE2I)
+mat_sigma[3,5] <- gdata$gammaAo
+mat_sigma[10,5] <- 1/deltaE2I
+
+### infectious
+
+mat_sigma[6,6] <- -(gammaAg+muA)
+mat_sigma[7,6] <- gammaAg
+
+mat_sigma[7,7] <- -(gdata$gammaAo+muAr)
+mat_sigma[8,7] <- gdata$gammaAo
+
+mat_sigma[8,8] <- -(gdata$gammaAh+muAr)
+mat_sigma[9,8] <- gdata$gammaAo
+
+mat_sigma[9,9] <- -(gammaAg+muA)
+mat_sigma[10,9] <- gammaAg
+
+mat_sigma[10,10] <- -(gdata$gammaAo+muAr)
+mat_sigma[9,10] <- gdata$gammaAo
+
+## human
+
+mat_sigma[11,11] <- -gdata$muH
+mat_sigma[12,11] <- gdata$muH
+mat_sigma[12,12] <- -gdata$rhoH
+
+# matrix E (mat_E) is an auxiliary matrix that singles out the rows and columns relevant for the reduced set of states
+mat_E = matrix(0, ncol = 3, nrow = 12)
+
+rownames(mat_E) <- names(epi_states_t)
+colnames(mat_E) <- colnames(mat_T)[rowSums(mat_T) != 0]
+
+mat_E[1,1] <- 1
+mat_E[4,2] <- 1
+mat_E[11,3] <- 1
+
+# matrix KL (mat_KL) is the NGM with Large domain
+mat_KL <- -mat_T %*% inv(mat_sigma)
+# approximate dominant eigenvalue
+R0 = fastmatrix::power.method(mat_KL, only.value = TRUE)
+
+# find the next-generation matrixR product of matrix
+K = (t(mat_E) %*% mat_T) %*% -(inv(mat_sigma) %*% mat_E)
+
+if(R0 == 0)
+ R0 = (1/2)*(tr(K) + sqrt(tr(K)^2-4*det(K)))
+
+}
+```
+
diff --git a/vignettes/SpatVec/SpatVec.cpg b/vignettes/SpatVec/SpatVec.cpg
new file mode 100644
index 0000000000000000000000000000000000000000..3ad133c048f2189041151425a73485649e6c32c0
--- /dev/null
+++ b/vignettes/SpatVec/SpatVec.cpg
@@ -0,0 +1 @@
+UTF-8
\ No newline at end of file
diff --git a/vignettes/SpatVec/SpatVec.dbf b/vignettes/SpatVec/SpatVec.dbf
new file mode 100644
index 0000000000000000000000000000000000000000..a5c6cdc872053240abde2793f5941661cf732ada
Binary files /dev/null and b/vignettes/SpatVec/SpatVec.dbf differ
diff --git a/vignettes/SpatVec/SpatVec.prj b/vignettes/SpatVec/SpatVec.prj
new file mode 100644
index 0000000000000000000000000000000000000000..ae0206b68de2ed81139b89a08ddd36a6b0ed7e35
--- /dev/null
+++ b/vignettes/SpatVec/SpatVec.prj
@@ -0,0 +1 @@
+PROJCS["RGF_1993_Lambert_93",GEOGCS["GCS_RGF_1993",DATUM["D_RGF_1993",SPHEROID["GRS_1980",6378137.0,298.257222101]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]],PROJECTION["Lambert_Conformal_Conic"],PARAMETER["False_Easting",700000.0],PARAMETER["False_Northing",6600000.0],PARAMETER["Central_Meridian",3.0],PARAMETER["Standard_Parallel_1",49.0],PARAMETER["Standard_Parallel_2",44.0],PARAMETER["Latitude_Of_Origin",46.5],UNIT["Meter",1.0]]
\ No newline at end of file
diff --git a/vignettes/SpatVec/SpatVec.shp b/vignettes/SpatVec/SpatVec.shp
new file mode 100644
index 0000000000000000000000000000000000000000..42e4b72122816040d6dc1d4cf284d26427e9905e
Binary files /dev/null and b/vignettes/SpatVec/SpatVec.shp differ
diff --git a/vignettes/SpatVec/SpatVec.shx b/vignettes/SpatVec/SpatVec.shx
new file mode 100644
index 0000000000000000000000000000000000000000..65b682c2a90cd763e10f20df24ef366d8f99b38f
Binary files /dev/null and b/vignettes/SpatVec/SpatVec.shx differ
diff --git a/vignettes/Tutorial.Rmd b/vignettes/Tutorial.Rmd
new file mode 100644
index 0000000000000000000000000000000000000000..39a09a22354145736730c2647dbe16108d784e79
--- /dev/null
+++ b/vignettes/Tutorial.Rmd
@@ -0,0 +1,222 @@
+---
+title: "Tutorial: How to use arbocartoR"
+output: rmarkdown::html_vignette
+date: "`r Sys.Date()`"
+vignette: >
+ %\VignetteIndexEntry{Tutorial: How to use arbocartoR}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>"
+)
+```
+
+```{r setup}
+
+# Packages --------------------------------------------------------------------
+suppressPackageStartupMessages({
+ suppressWarnings({
+library(arbocartoR)
+library(data.table)
+library(magrittr)
+library(tidyterra)
+library(ggplot2)
+library(sf)
+library(TDLM)
+ })
+})
+```
+
+# Introduction
+
+This tutorial aims at describing the different features of the R package `arbocartoR`.
+The main purpose of the `arbocartoR`'s package is to simulate spatial and temporal dynamics of Aedes mosquitoes populations, as well as epidemiological dynamics of three arbovirosis (dengue, zika and chikungunya) through human and vector populations.
+
+## General data
+Input data:
+
+* *parcels*: data.table where each row is a node/parcel and columns are attributes. The minimum required attributes are ids (ID), population count (POP), maximal fix/anthropic carrying capacity (Kfix, in number of larvae), maximal carrying capacity varying with rainfall (Kvar, in number of larvae). Optional attributes in case of use of meteorological data from meteorological stations: id of the associated meteorological station (STATION), average altitude (ALT_M).
+
+* *meteo*: data.table with meteorological data including four columns: node or meteorological station ids (ID), date (DATE), daily rainfall (RR, in mm), daily mean temperature (TP, in degrees)
+
+```{r}
+data(parcels)
+data(meteo)
+
+parcels
+meteo
+```
+
+Select a subset of parcels.
+
+```{r}
+parcels %<>% .[startsWith(ID, "06") & (grepl("Gatt", NOM_COM) | grepl("Saint-Jeannet", NOM_COM) | grepl("La Gaude", NOM_COM)),]
+```
+
+Run simple simulation
+
+```{r}
+start_time <- Sys.time()
+
+traj <- run_arbocartoR(parcels = parcels,
+ meteo = meteo,
+ n_sim = 1,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date)
+
+end_time <- Sys.time()
+
+end_time - start_time
+```
+
+## Local data
+
+# Introduction of human mobility
+
+```{r}
+
+SpatVec <- system.file("shape/SpatVec.shp", package = "arbocartoR") %>% terra::vect(.)
+SpatVec <- SpatVec[SpatVec$ID %in% parcels$ID, ]
+
+mMov <- build_mMov(SpatVec,
+ law = "NGravExp",
+ p2move = 0.715,
+ verbose = T)
+
+SpatVec$pMovij <- mMov$proba_ij[rownames(mMov$proba_ij) == "060650102",]
+SpatVec$pMovji <- mMov$proba_ji[rownames(mMov$proba_ji) == "060650102",]
+
+ggplot(SpatVec) +
+ geom_spatvector(aes(fill = pMovij), color = NA) +
+ scale_fill_continuous(low = "white", high = "#590003") +
+ ggtitle("Probability to visit a parcel for residents of the introduction parcel: 061220000") +
+ labs(fill = "")
+
+ggplot(SpatVec) +
+ geom_spatvector(aes(fill = pMovji), color = NA) +
+ scale_fill_continuous(low = "white", high = "#590003") +
+ ggtitle("Probability to visit the introduction parcel: 061220000, depending on the residence") +
+ labs(fill = "")
+
+```
+
+# Introduction of local preventive control
+
+Initialize the dataset for preventive control
+
+```{r}
+prev_control <- data.table(
+ action = character(),
+ loc = factor(),
+ start = structure(numeric(0), class = "Date"),
+ end = structure(numeric(0), class = "Date"),
+ p = numeric()
+)
+```
+
+Reduce the environment carrying capacities (destruction of breeding sites, action = "K") by 20% (p = 0.2) in the parcel "060640000" (loc) every day from July, 1 to July, 7.
+
+```{r}
+prev_control %<>% list(., data.table(
+ action = "K",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.2)) %>% rbindlist(fill = TRUE)
+```
+
+Increase the larvae mortality (larviciding, action = "L") by 20% (p = 0.2) in the parcel "060640000" (loc) every day from July, 1 to July, 7 and by 50% in the parcel "061220000" (loc) every day from July, 7 to July, 15.
+
+```{r}
+prev_control %<>% list(., data.table(
+ action = "L",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.2)) %>% rbindlist(fill = TRUE)
+
+prev_control %<>% list(., data.table(
+ action = "L",
+ loc = "061220000",
+ start = as.Date("2022/07/07"),
+ end = as.Date("2022/07/15"),
+ p = 0.5)) %>% rbindlist(fill = TRUE)
+
+```
+
+Increase the mosquito adult mortality (fumigation, action = "A") by 20% (p = 0.2) in the parcel "061220000" (loc) every day from July, 1 to July, 7 and by 80% in the parcel "060640000" (loc) every day from July, 1 to July, 7.
+
+```{r}
+prev_control %<>% list(., data.table(
+ action = "A",
+ loc = "061220000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.2)) %>% rbindlist(fill = TRUE)
+
+prev_control %<>% list(., data.table(
+ action = "A",
+ loc = "060640000",
+ start = as.Date("2022/07/01"),
+ end = as.Date("2022/07/07"),
+ p = 0.8)) %>% rbindlist(fill = TRUE)
+```
+
+```{r}
+
+# run simple simulation with prev_control
+start_time <- Sys.time()
+
+traj <- run_arbocartoR(parcels = parcels,
+ meteo = meteo,
+ n_sim = 1,
+ start_date = min(meteo$DATE) %>% as.Date,
+ end_date = max(meteo$DATE) %>% as.Date,
+ prev_control = prev_control)
+
+end_time <- Sys.time()
+end_time - start_time
+```
+
+# Set local dataset
+```{r}
+ldata <- build_ldata(parcels,
+ meteo,
+ vector = "Ae. albopictus (D)",
+ start_date = "2022/01/01" %>% as.Date,
+ end_date = "2022/11/30" %>% as.Date,
+ # mMov = mMov,
+ prev_control = prev_control)
+
+```
+
+# Introduction of exposed individuals
+
+```{r}
+introduction_pts <- build_E_random(
+ period_start <- "2022/07/01" %>% as.Date,
+ period_end <- "2022/07/15" %>% as.Date,
+ n_ind = 10,
+ n_events = 1,
+ stage = "Eh",
+ loc = parcels$ID
+)
+
+# run simple simulation with prev_control
+start_time <- Sys.time()
+
+traj <- run_arbocartoR(parcels = parcels,
+ ldata = ldata,
+ n_sim = 1,
+ start_date = "2022/01/01" %>% as.Date,
+ end_date = "2022/11/30" %>% as.Date,
+ introduction_pts = introduction_pts,
+ initMosq = 1e+05)
+
+end_time <- Sys.time()
+end_time - start_time
+```
diff --git a/vignettes/mobility_test.Rmd b/vignettes/mobility_test.Rmd
new file mode 100644
index 0000000000000000000000000000000000000000..fef63e31d4ec790678146bd4e6d2f0c94cb15037
--- /dev/null
+++ b/vignettes/mobility_test.Rmd
@@ -0,0 +1,61 @@
+---
+title: "Validate mobility approach in arbocartoR"
+output: rmarkdown::html_vignette
+date: "`r Sys.Date()`"
+vignette: >
+ %\VignetteIndexEntry{Validate mobility approach in arbocartoR}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+ collapse = TRUE,
+ comment = "#>"
+)
+```
+
+# Initialization
+
+```{r setup}
+
+### Packages
+
+# install if not already done:
+# remotes::install_gitlab("umr-astre/arbocartoR", host = "https://forgemia.inra.fr")
+
+suppressPackageStartupMessages({
+ suppressWarnings({
+ library(magrittr)
+ library(arbocartoR)
+ })
+})
+```
+
+# Data
+Load test data (change the number to change the french department to work with)
+
+```{r}
+SpatVec <- system.file("shape/SpatVec.shp",
+ package="arbocartoR") %>%
+ terra::vect(.)
+```
+
+
+# Generate the mobility metrics
+
+```{r}
+mobility_metrics <- build_mMov(SpatVec, p2move = 0.7)
+
+# daily probability to move from i (rows) to j (columns)
+pij <- mobility_metrics$proba_ij * mobility_metrics$p2move
+
+# daily probability that a person in i (columns) come from j (rows)
+pji <- mobility_metrics$proba_ji * (1 - mobility_metrics$pii)
+```
+
+# Documentation
+
+```{r eval = F}
+? build_mMov
+```
diff --git a/vignettes/my-vignette.Rmd b/vignettes/my-vignette.Rmd
deleted file mode 100644
index 78ca6a319b289762bd35688a0a66983b3c5258a7..0000000000000000000000000000000000000000
--- a/vignettes/my-vignette.Rmd
+++ /dev/null
@@ -1,19 +0,0 @@
----
-title: "my-vignette"
-output: rmarkdown::html_vignette
-vignette: >
- %\VignetteIndexEntry{my-vignette}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-```{r, include = FALSE}
-knitr::opts_chunk$set(
- collapse = TRUE,
- comment = "#>"
-)
-```
-
-```{r setup}
-library(ArboRisk)
-```
diff --git a/work_in_progress/.gitignore b/work_in_progress/.gitignore
deleted file mode 100644
index 6e55a39499fd61f6087c9fc754eed2cc2c708889..0000000000000000000000000000000000000000
--- a/work_in_progress/.gitignore
+++ /dev/null
@@ -1,11 +0,0 @@
-compartments.Rda
-gdata.Rda
-ldata.Rda
-pts_fun.Rda
-stoch_transitions.Rda
-tspan.Rda
-u0.Rda
-v0.Rda
-data
-PARCELLE.rda
-METEO.rda
diff --git a/work_in_progress/contact_method.R b/work_in_progress/contact_method.R
deleted file mode 100644
index eb7ab9f63f000410d5155704b966f9b025d65942..0000000000000000000000000000000000000000
--- a/work_in_progress/contact_method.R
+++ /dev/null
@@ -1,80 +0,0 @@
-# Create contact
-
-## Levels of contact
-
-## Probabilities of contact
-# Very high within patch (patch level)
-Hp <- 0.95
-# Medium (eg. between patches of a city ; city level)
-Mp <- 0.25
-# Low (eg. between patches of a department ; department level)
-Lp <- 0.05
-# Very low (eg. between patches of different departments ; global level)
-Gp <- 0.01
-
-library(ohenery)
-normalize(c(Hp, Mp, Lp, Gp))
-
-# High within patch (patch level)
-Hp <- 0.59375
-# Medium between patches of a city (city level)
-Mp <- 0.28125
-# Low between patches of a department (department level)
-Lp <- 0.09375
-# Very low between patches of different departments (national level)
-Gp <- 0.03125
-
-PARCELLE[, SL2 := NOM_COM %>% factor %>% as.numeric]
-PARCELLE[, SL3 := INSEE_COM %>% substr(., 1, 2) %>% factor %>% as.numeric]
-save(PARCELLE, file = "D:/Pachka_tmp/1-Modeling/dengue-risk-assessment/data/PARCELLE.rda")
-save(PARCELLE, file = "D:/Pachka_tmp/1-Modeling/dengue-risk-assessment/work_in_progress/PARCELLE.rda")
-
-
-int IP;
-IP = u[3];
-
-int TP;
-TP = pop;
-
-int IC;
-int TC;
-if(ldata[1] == ){
- IC = u[...] + u[...] + ...;
- TC = u[...] + u[...] + ...;
-}
-
-
-
-ISL2 <- c()
-for(SpUnit in PARCELLE$SL2 %>% unique){
- ISL2 %<>% append(., paste0(c("x = if(ldata[1] == ", SpUnit ,"){ IC = ", paste0("u[", 2 + which(PARCELLE$SL2 == SpUnit) - 1,"]", collapse = " + "), "; TC = ", paste0("u[", 1 + which(PARCELLE$SL2 == SpUnit) - 1,"] + u[", 2 + which(PARCELLE$SL2 == SpUnit) - 1,"] + u[",3 + which(PARCELLE$SL2 == SpUnit) - 1,"] + u[", 4 + which(PARCELLE$SL2 == SpUnit) - 1,"]", collapse = " + "), ";}"), collapse = ""))
- }
-
-
-ISL3 <- c()
-for(SpUnit in PARCELLE$SL3 %>% unique){
- ISL3 %<>% append(., paste0(c("x = if(ldata[2] == ", SpUnit ,"){ IC = ", paste0("u[", 2 + which(PARCELLE$SL3 == SpUnit) - 1,"]", collapse = " + "), "; TC = ", paste0("u[", 1 + which(PARCELLE$SL3 == SpUnit) - 1,"] + u[", 2 + which(PARCELLE$SL3 == SpUnit) - 1,"] + u[",3 + which(PARCELLE$SL3 == SpUnit) - 1,"] + u[", 4 + which(PARCELLE$SL3 == SpUnit) - 1,"]", collapse = " + "), ";}"), collapse = ""))
-}
-
-int ID;
-int TD;
-if(ldata[2] == ){
- ID = u[...] + u[...] + ... ;
- TD = u[...] + u[...] + ... ;
-}
-
-double pI;
-pI = PLp * (IP/TP) +
- CLp * (sum(IC) - IP)/(sum(TC)-TP) +
- DLp * (sum(ID) - IC)/sum(TD))-TC) +
- NLp * (sum(IN) - ID)/sum(TN)-TD)
-
-
-## >>> cummulative probabilities for the patch
-
-# Medium between patches of a city (city level)
-CLp <- 0.65
-# Low between patches of a department (department level)
-DLp <- 0.35
-# Very low between patches of different departments (national level)
-NLp <- 0.05
diff --git a/work_in_progress/main.R b/work_in_progress/main.R
deleted file mode 100644
index 732f74dabf48063811cb239906ca06bb9fc720b2..0000000000000000000000000000000000000000
--- a/work_in_progress/main.R
+++ /dev/null
@@ -1,112 +0,0 @@
-### Date of change: 20/02/2023
-### Authors: Pachka, Ewy, Elena
-
-## This script is under development at the UMR Astre - Cirad.
-
-## The aim of the script is to develop a model to simulate
-## viral dynamics of dengue serotypes in a disease-free context
-## taking into account spatial variability, vector population dynamics
-## and human commuting.
-
-rm(list = ls(all.names = TRUE)) # clear all objects includes hidden objects.
-gc() # free up memory and report the memory usage.
-
-###################################
-### Load packages and functions ###
-###################################
-devtools::document()
-devtools::install(quick = T)
-devtools::test()
-
-library(ArboRisk)
-
-library(data.table)
-library(magrittr)
-
-####################
-### General data ###
-####################
-# input data:
-# PARCELLE : table where each row is a node and columns are attributes
-# METEO: table with four columns nodeID, date, daily rainfall, daily mean temperature
-
-data(PARCELLE)
-data(METEO)
-PARCELLE %<>% .[startsWith(PARCELLE$ID, "11"),]
-# PARCELLE %<>% .[1:100,]
-METEO
-
-###########################################
-### Introduction of exposed individuals ###
-###########################################
-
-introduction_pts <- build_E_random(
- period_start <- "2022/08/10" %>% as.Date,
- period_end <- "2022/08/30" %>% as.Date,
- n_ind = 1:10,
- n_events = 5,
- stage = "Eh",
- loc = PARCELLE$ID[1])
-
-######################################
-### Introduction of human mobility ###
-######################################
-
-SpatVec <- "data/SpatVec.shp" %>% terra::vect(.)
-SpatVec <- SpatVec[SpatVec$ID %in% PARCELLE$ID, ]
-
-mMov <- build_mMov(SpatVec,
- law = "GravExp",
- param = 0.00001,
- p2move = 0.2,
- pCom = 0.7)
-
-ldata <- build_ldata(PARCELLE,
- METEO,
- vector_species = "Ae. albopictus",
- mMov = mMov)
-
-###################
-### Simulations ###
-###################
-
-# without introductions
-start_time <- Sys.time()
-
-traj <- runArboRisk(PARCELLE = PARCELLE,
- vector_species = "Ae. albopictus",
- METEO = METEO,
- n_sim = 1)
-
-end_time <- Sys.time()
-end_time - start_time
-
-# without introductions
-start_time <- Sys.time()
-
-traj <- runArboRisk(PARCELLE = PARCELLE,
- vector_species = "Ae. albopictus",
- ldata = ldata,
- n_sim = 30,
- start_date = min(METEO$DATE) %>% as.Date,
- end_date = max(METEO$DATE) %>% as.Date)
-
-end_time <- Sys.time()
-end_time - start_time
-
-# with introductions
-start_time <- Sys.time()
-
-traj <- runArboRisk(PARCELLE = PARCELLE,
- vector_species = "Ae. albopictus",
- ldata = ldata,
- n_sim = 2,
- start_date = min(METEO$DATE) %>% as.Date,
- end_date = max(METEO$DATE) %>% as.Date,
- introduction_pts = introduction_pts)
-
-end_time <- Sys.time()
-end_time - start_time
-
-# in each simulation see if the infection spread other IRIS
-lapply(traj, function(x) x[ninfh>1 & ID != introduction_pts$dest %>% unique, ID] %>% unique %>% length) %>% unlist
diff --git a/work_in_progress/mapMeanInf.R b/work_in_progress/mapMeanInf.R
deleted file mode 100644
index 525230d9760c2d040916874bd659f114faf29728..0000000000000000000000000000000000000000
--- a/work_in_progress/mapMeanInf.R
+++ /dev/null
@@ -1,95 +0,0 @@
-### Date of change: 20/02/2023
-### Authors: Pachka, Ewy, Elena
-
-## This script is under development at the UMR Astre - Cirad.
-
-## The aim of the script is to develop a model to simulate
-## viral dynamics of dengue serotypes in a disease-free context
-## taking into account spatial variability, vector population dynamics
-## and human commuting.
-
-rm(list = ls(all.names = TRUE)) # clear all objects includes hidden objects.
-gc() # free up memory and report the memory usage.
-
-###################################
-### Load packages and functions ###
-###################################
-devtools::document()
-devtools::install(quick = T)
-devtools::test()
-
-library(ArboRisk)
-
-library(data.table)
-library(magrittr)
-
-####################
-### General data ###
-####################
-# input data:
-# PARCELLE : table where each row is a node and columns are attributes
-# meteo: table with four columns nodeID, date, daily rainfall, daily mean temperature
-
-data(PARCELLE)
-PARCELLE %<>% .[startsWith(PARCELLE$ID, c("11", "34", "30")),]
-
-PARCELLE[startsWith(PARCELLE$ID, c("34"))|
- startsWith(PARCELLE$ID, c("11"))|
- startsWith(PARCELLE$ID, c("30"))] %>% plot
-# PARCELLE %<>% .[1:100,]
-METEO
-
-###########################################
-### Introduction of exposed individuals ###
-###########################################
-
-introduction_pts <- data.table(
- time = "2020/07/01" %>% as.Date,
- node = PARCELLE$ID,
- n = 1,
- select = "Eh")
-
-
-######################################
-### Introduction of human mobility ###
-######################################
-
-ldata <- build_ldata(PARCELLE,
- METEO,
- vector_species = "Ae. albopictus")
-
-###################
-### Simulations ###
-###################
-
-# without introductions
-start_time <- Sys.time()
-
-traj <- runArboRisk(PARCELLE = PARCELLE,
- vector_species = "Ae. albopictus",
- ldata = ldata,
- n_sim = 30,
- start_date = min(METEO$DATE) %>% as.Date,
- end_date = max(METEO$DATE) %>% as.Date,
- introduction_pts = introduction_pts)
-
-end_time <- Sys.time()
-end_time - start_time
-
-
-filename <- "work_in_progress/data/IRIS-GE/IRIS_GE.SHP"
-spatialFrance <- vect(filename)
-
-result <- lapply(traj, function(x){
- x[, max(ninfh), by = ID]
- }) %>% do.call(rbind, .)
-
-spatialFrance[match(result[, min(V1), by = ID]$ID, spatialFrance$CODE_IRIS),"mean"] <- result[, mean(V1), by = ID]$V1
-spatialFrance[match(result[, min(V1), by = ID]$ID, spatialFrance$CODE_IRIS),"max"] <- result[, max(V1), by = ID]$V1
-spatialFrance[match(result[, min(V1), by = ID]$ID, spatialFrance$CODE_IRIS),"min"] <- result[, min(V1), by = ID]$V1
-spatialFrance[match(result[, min(V1), by = ID]$ID, spatialFrance$CODE_IRIS),"median"] <- result[, median(V1), by = ID]$V1
-
-spatialFrance[startsWith(spatialFrance$CODE_IRIS, c("11"))|
- startsWith(spatialFrance$CODE_IRIS, c("34"))|
- startsWith(spatialFrance$CODE_IRIS, c("30"))] %>%
- plot(., "mean", col=rev(heat.colors(12)), type = 'continuous')
diff --git a/work_in_progress/processInput.R b/work_in_progress/processInput.R
deleted file mode 100644
index be5f63f5a9de12cd90cbde2b55e0743c6c18cf79..0000000000000000000000000000000000000000
--- a/work_in_progress/processInput.R
+++ /dev/null
@@ -1,95 +0,0 @@
-library(terra)
-library(geodata)
-
-#### Meteorological data ####
-METEO <- read.csv2("work_in_progress/data/METEO_20210101_20221130.txt")
-METEO %>% setDT
-METEO %<>% cleanMETEO
-
-METEO[, `:=`(TN = as.numeric(TN),
- TX = as.numeric(TX))]
-METEO[, TP := (TN+TX)/2]
-METEO[, `:=`(TN = NULL,
- TX = NULL)]
-
-### List stations ###
-filename <- "work_in_progress/data/stations.txt"
-STATIONS <- read.csv2(filename, sep = ";", dec = ".")
-setDT(STATIONS)
-STATIONS %<>% .[INSEE %in% METEO$ID] # Keep stations for which we have METEOrological data
-#remove unsed columns
-STATIONS[, `:=`(TYPE = NULL,
- NOM = NULL,
- ETAT = NULL,
- X = NULL)]
-STATIONS[, ALTITUDE := substr(ALTITUDE, 1, 4) %>% as.numeric]
-
-#### List of administrative unit ####
-filename <- "work_in_progress/data/IRIS-GE/IRIS_GE.SHP"
-PARCELLE <- vect(filename)
-terra::crs(PARCELLE, describe = T)
-### Test limit the number of parcelles
-# PARCELLE %<>% .[startsWith(PARCELLE$INSEE_COM, "34"),]
-# plot(PARCELLE)
-
-### For each administrative unit define:
-
-## Surface ##
-PARCELLE$SURF_HA <- expanse(PARCELLE,
- unit="ha",
- transform=TRUE)
-
-## KLfix KLvar KPfix KPvar - to improve based on land cover ##
-PARCELLE$KLfix <- 150 * PARCELLE$SURF_HA
-PARCELLE$KLvar <- 50 * PARCELLE$SURF_HA
-PARCELLE$KPfix <- 150 * PARCELLE$SURF_HA
-PARCELLE$KPvar <- 50 * PARCELLE$SURF_HA
-
-## Average altitude ##
-# download raster
-elevation <- elevation_30s(country="FRA", path = "work_in_progress/data/")
-# project raster
-elevation %<>% project(., "epsg:2154")
-# compute average
-PARCELLE$ALTITUDE_UNIT <- terra::extract(elevation, PARCELLE, fun=mean, na.rm=TRUE) %>% .$FRA_elv_msk
-# Absence of missing values?
-PARCELLE$ALTITUDE_UNIT %>% is.na %>% sum %>% equals(0)
-# Temporary replace na by 0 -- FIX ME LATER
-# Ignore the error
-# https://github.com/sneumann/xcms/issues/288
-PARCELLE[is.na(PARCELLE$ALTITUDE_UNIT)]$ALTITUDE_UNIT <- 0
-# FIX ME: thinnk about it
-
-## Population ##
-# download raster
-pop <- geodata::population(2020, 0.5, path = "work_in_progress/data/")
-# project raster
-pop %<>% terra::project(., elevation)
-# compute average
-PARCELLE$POP <- terra::extract(pop, PARCELLE, fun=sum, na.rm=TRUE) %>% .$population_density
-# Absence of missing values?
-PARCELLE$POP %>% is.na %>% sum %>% equals(0)
-# Turn density into number of persons
-PARCELLE$POP %<>% multiply_by(PARCELLE$SURF_HA/100) %>% round
-
-## Unique METEOrological station ##
-# two options: only spatial considerations or the weighted by the human population
-# look at the function nearest from terra package
-
-# turn STATIONS data.table into points
-STATIONS_pts <- STATIONS %>% vect(.,
- geom=c("LONGITUDE", "LATITUDE"),
- crs = "epsg:4326")
-STATIONS_pts %<>% terra::project(., elevation)
-
-PARCELLE$STATION <- STATIONS[nearest(PARCELLE, STATIONS_pts) %>% .$to_id, INSEE]
-PARCELLE$ALTITUDE_STATION <- STATIONS[nearest(PARCELLE, STATIONS_pts) %>% .$to_id, ALTITUDE]
-
-## add the difference of altitude between the average altitude of the administrative unit and the altitude of the METEOrological station (diff_alt = ALTITUDE_UNIT - ALTITUDE_STATION)
-PARCELLE$diff_alt <- PARCELLE$ALTITUDE_UNIT - PARCELLE$ALTITUDE_STATION
-
-names(PARCELLE)[4] <- "ID"
-
-# turn PARCELLE into table
-PARCELLE %<>% as.data.frame
-setDT(PARCELLE)
diff --git a/work_in_progress/testArbocarto.R b/work_in_progress/testArbocarto.R
deleted file mode 100644
index 29be534ad5d99884c1ec65c5b656db1533897e5b..0000000000000000000000000000000000000000
--- a/work_in_progress/testArbocarto.R
+++ /dev/null
@@ -1,184 +0,0 @@
-### Date of change: 27/02/2023
-### Authors: Pachka, Ewy, Elena
-
-## This script is under development at the UMR Astre - Cirad.
-
-## The aim of the script is to develop a model to simulate
-## viral dynamics of dengue serotypes in a disease-free context
-## taking into account spatial variability, vector population dynamics
-## and human commuting.
-
-rm(list = ls(all.names = TRUE)) # clear all objects includes hidden objects.
-gc() # free up memory and report the memory usage.
-
-###################################
-### Load packages and functions ###
-###################################
-devtools::install(quick = T)
-
-library(data.table)
-library(magrittr)
-library(ggplot2)
-
-library(ArboRisk)
-library(SimInf)
-
-# Parallel processing
-library(parallel)
-library(doParallel)
-library(foreach)
-
-library(terra)
-library(geodata)
-
-####################
-### General data ###
-####################
-# input data:
-# PARCELLE : table where each row is a node and columns are attributes
-# meteo: table whit four columns nodeID, date, daily rainfall, daily mean temperature
-
-#### Meteorological data ####
-meteo <- read.csv2("work_in_progress/data/TRAVAIL/CSV/METEO/34154001.csv")
-meteo <- read.csv2("work_in_progress/data/TRAVAIL/CSV/METEO/34217001.csv") %>% rbind(.,meteo)
-meteo %>% setDT
-meteo %<>% cleanmeteo
-meteo$DATE %<>% gsub("-", "", .)
-meteo[, `:=`(RR = as.numeric(RR),
- TP = (as.numeric(TN)+ as.numeric(TX))/2)]
-
-### List stations ###
-filename <- "work_in_progress/data/TRAVAIL/SHP/STATIONS/StationsMeteo.shp"
-STATIONS <- vect(filename)
-terra::crs(STATIONS, describe = T)
-STATIONS$ALTITUDE <- STATIONS$Altitude
-STATIONS$INSEE <- STATIONS$Numero
-
-### TEST ARBOCARTO
-#### List of administrative unit ####
-filename <- "work_in_progress/data/TRAVAIL/SHP/PARCELLES/IRIS/IRISGE_MTP_KLocs.shp"
-PARCELLES <- vect(filename)
-terra::crs(PARCELLES, describe = T)
-
-### For each administrative unit define:
-## Surface ##
-PARCELLES$SURF_HA <- PARCELLES$SurfHA
-
-## KLfix KLvar KPfix KPvar
-PARCELLES$KPfix <- PARCELLES$KLfix
-PARCELLES$KPvar <- PARCELLES$KLvar
-
-## Average altitude ##
-# download raster
-elevation <- elevation_30s(country="FRA", path = "work_in_progress/data/")
-# projet raster
-elevation %<>% project(., "epsg:2154")
-
-PARCELLES$ALTITUDE_UNIT <- PARCELLES$Altitude
-
-## Population ##
-# download raster
-pop <- geodata::population(2020, 0.5, path = "work_in_progress/data/")
-# projet raster
-pop %<>% terra::project(., elevation) ## FIX ME: why do I have to pass by elevation
-# compute average
-PARCELLES$POP <- terra::extract(pop, PARCELLES, fun=sum, na.rm=TRUE) %>% .$population_density
-# Absence of missing values?
-PARCELLES$POP %>% is.na %>% sum %>% equals(0)
-# Turn density into number of persons
-PARCELLES$POP %<>% multiply_by(PARCELLES$SURF_HA/100)
-PARCELLES$pop <- PARCELLES$POP
-
-## Unique meteorological station ##
-PARCELLES$STATION <- nearest(PARCELLES, STATIONS)[,"to_id"] %>% as.data.frame %>% .[,1] %>% STATIONS$INSEE[.]
-PARCELLES$ALTITUDE_STATION <- nearest(PARCELLES, STATIONS)[,"to_id"] %>% as.data.frame %>% .[,1] %>% STATIONS$Altitude[.]
-
-plot(PARCELLES, "STATION")
-plot(STATIONS, add =T)
-## add the difference of altitude between the average altitude of the administrative unit and the altitude of the meteorological station (diff_alt = ALTITUDE_UNIT - ALTITUDE_STATION)
-PARCELLES$diff_alt <- PARCELLES$ALTITUDE_UNIT - PARCELLES$ALTITUDE_STATION
-
-# writeVector(PARCELLES,
-# filename = "D:/Pachka_tmp/1-ARBOCARTO/Jeux_de_Donnees_work_in_progress/Jeux_de_Donnees_work_in_progress/Montpellier/TRAVAIL/SHP/PARCELLES/IRIS/IRIS_KL_POP.shp",
-# overwrite=TRUE)
-
-PARCELLES %<>% as.data.frame
-setDT(PARCELLES)
-
-PARCELLES %>% setnames(., "CODE_IRIS", "ID")
-PARCELLES %>% setnames(., "diff_alt", "DIFF_ALT")
-
-PARCELLES[, PARCELLE %>% names, with = FALSE]
-
-meteo
-meteo %>% setnames(., "POSTE", "ID")
-meteo[, DATE := as.Date(DATE, format = "%Y%m%d")]
-meteo[, TP := (as.numeric(TN) + as.numeric(TX))/2]
-meteo[, METEO %>% names, with = FALSE]
-
-
-start_time <- Sys.time()
-
-traj <- runArboRisk(PARCELLE = PARCELLES,
- vector_species = "Ae. albopictus",
- METEO = meteo,
- n_sim = 30)
-
-end_time <- Sys.time()
-end_time - start_time
-
-#####
-##### Explore output
-#####
-result <- traj
-traj %<>% .[[1]]
-traj %>% setDT
-traj
-
-filename <- "work_in_progress/data/TRAVAIL/SHP/PARCELLES/IRIS/IRISGE_MTP_KLocs.shp"
-PARCELLES <- vect(filename)
-PARCELLES$R0 <- traj[, mean(R0), by = node][, V1]
-plot(PARCELLES, "R0", col=rev(heat.colors(12)))
-
-### read ARBOCARTO output
-
-folder <- "work_in_progress/data/RESULTATS/"
-output <- vect(paste0(folder, "IRISGE_MTP_KLocs_20180101_20181014_v1.shp"))
-output <- vect(paste0(folder, "IRISGE_MTP_KLocs_20170101_20171231_v2.shp"))
-terra::crs(output, describe = T)
-output %<>% as.data.frame
-output %>% setDT
-
-tspan <- seq(from = 0, to = (time_max + nYR_init*365) - 1, by = 1)
-
-startD <- (as.Date("2018-10-14", format="%Y-%m-%d") - as.Date("2018-01-01", format="%Y-%m-%d")) %>%
- as.numeric
-startD <- max(tspan)-startD
-
-endD <- (as.Date("2017-01-01", format="%Y-%m-%d") - as.Date("2018-10-14", format="%Y-%m-%d")) %>%
- as.numeric
-endD <- max(tspan) - endD
-
-traj2plot <- traj[node == 1 & DATE >= as.Date("2017-01-01", format="%Y-%m-%d") & DATE <= as.Date("2017-12-31", format="%Y-%m-%d"),]
-
-outputs <- data.frame(
- # arbocarto_oeufs = output[id == "340140000", oeufs],
- # R_oeufs = traj2plot[, Em],
- arbocarto_larves = output[id == "340140000", larves],
- R_larves = traj2plot[, Lm],
- arbocarto_Adultestot = output[id == "340140000", adultestot],
- R_Adultestot = traj2plot[, Aemm+A1hm+A1gm+A1om+A2hm+A2gm+A2om],
- arbocarto_Ah = output[id == "340140000", ah],
- R_Ah = traj2plot[, A1hm+A2hm],
- id = traj2plot[, time])
-
-outputs %<>% reshape2::melt(., id='id')
-outputs$time <- seq(as.Date("2017-01-01"), as.Date("2017-12-31"), by="days")
-ggplot() +
- geom_line(data = outputs, aes(x = time, y = value, color = variable , group = variable), size = 1)
-
-plot(traj[node == 1 & time > (2477-287), Em] ~ traj[node == 1 & time > (2477-287), time])
-plot(traj[node == 1 & time > (2477-287), Lm] ~ traj[node == 1 & time > (2477-287), time])
-
-
-
diff --git a/work_in_progress/test_TDLM.R b/work_in_progress/test_TDLM.R
deleted file mode 100644
index 3b1c366556d3a8d44719239c83a21eb228487e8b..0000000000000000000000000000000000000000
--- a/work_in_progress/test_TDLM.R
+++ /dev/null
@@ -1,218 +0,0 @@
-### Date of change: 27/02/2023
-### Authors: Pachka, Ewy, Elena
-
-## This script is under development at the UMR Astre - Cirad.
-
-## The aim of the script is to develop a model to simulate
-## viral dynamics of dengue serotypes in a disease-free context
-## taking into account spatial variability, vector population dynamics
-## and human commuting.
-
-rm(list = ls(all.names = TRUE)) # clear all objects includes hidden objects.
-gc() # free up memory and report the memory usage.
-
-###################################
-### Load packages and functions ###
-###################################
-# devtools::install(quick = T)
-
-library(data.table)
-library(magrittr)
-library(ggplot2)
-
-library(terra)
-library(geodata)
-
-library(TDLM)
-library(sf)
-####################
-### General data ###
-####################
-# input data:
-# PARCELLE : table where each row is a node and columns are attributes
-
-### TEST ARBOCARTO
-filename <- "work_in_progress/data/IRIS-GE/IRIS_GE.SHP"
-#### List of administrative unit ####
-PARCELLES_spa <- vect(filename)
-terra::crs(PARCELLES_spa, describe = T)
-
-### For each administrative unit define:
-## Surface ##
-PARCELLES_spa$SURF_HA <- expanse(PARCELLES_spa, unit="km", transform=TRUE)
-
-## Average altitude ##
-# download raster
-elevation <- elevation_30s(country="FRA", path = "work_in_progress/data/")
-# projet raster
-elevation %<>% project(., "epsg:2154")
-
-## Population ##
-# download raster
-pop <- geodata::population(2020, 0.5, path = "work_in_progress/data/")
-# projet raster
-pop %<>% project(., elevation)
-PARCELLES_spa %<>% project(., elevation)
-# compute average
-PARCELLES_spa$POP <- terra::extract(pop, PARCELLES_spa, fun=sum, na.rm=TRUE) %>% .$population_density
-# Absence of missing values?
-PARCELLES_spa$POP %>% is.na %>% sum %>% equals(0)
-
-# Turn density into number of persons
-PARCELLES_spa$POP %<>% multiply_by(PARCELLES_spa$SURF_HA)
-
-## turn to sf
-PARCELLES_spa %<>% sf::st_as_sf(.)
-# Choose dpt 34
-PARCELLES_spa <- subset(PARCELLES_spa, startsWith(CODE_IRIS, "34"))
-## Dimension of the object
-dim(PARCELLES_spa)
-
-PARCELLES_spa[1:10,]
-
-plot(PARCELLES_spa, max.plot = ncol(PARCELLES_spa))
-
-mass <- data.frame(Population = round(PARCELLES_spa$POP),
- Outcommuters = round(0.7*PARCELLES_spa$POP))
-
-row.names(mass) <- PARCELLES_spa$CODE_IRIS
-
-dim(mass)
-
-mi <- as.numeric(mass[,1])
-names(mi) <- rownames(mass)
-
-mj <- mi
-
-Oi <- as.numeric(mass[,2])
-names(Oi) <- rownames(mass)
-
-spi <- extract_spatial_information(PARCELLES_spa, id = "CODE_IRIS")
-
-
-distance2 <- spi$distance
-
-
-distance2[1:10, 1:10]
-
-check_format_names(vectors = list(mi = mi, mj = mj, Oi = Oi),
- matrices = list(distance = distance2),
- check = "format_and_names")
-
-res <- run_law_model(law = "NGravExp",
- mass_origin = mi,
- mass_destination = mj,
- distance = distance2,
- opportunity = NULL,
- param = 0.01,
- write_proba = TRUE,
-
- model = "DCM",
- nb_trips = sum(Oi),
- out_trips = Oi,
- average = FALSE,
- nbrep = 3)
-
-res$proba[1:10,1:10]
-
-res <- run_law(
- law = "GravExp",
- mass_origin = mi,
- distance = distance2,
- param = 0.01
-)
-
-res$proba
-
-res <- run_law(
- law = "GravExp",
- mass_origin = mi,
- distance = distance2,
- param = c(0.01,0.02)
-)
-
-res$parameter_1 %>% str
-res$parameter_2
-
-
-res <- run_law(
- law = "NGravExp",
- mass_origin = mi,
- distance = distance2,
- param = 0.01
-)
-res$proba %>% dim
-res$proba[1:10, 1:10]
-
-res$parameter_1
-res$parameter_2
-
-
-res <- run_law(
- law = "GravPow",
- mass_origin = mi,
- distance = distance2,
- param = c(0.01,0.02)
-)
-
-res$parameter_1
-res$parameter_2
-
-res <- run_law(
- law = "NGravPow",
- mass_origin = mi,
- distance = distance2,
- param = c(0.01,0.02)
-)
-
-res$parameter_1
-res$parameter_2
-
-#####
-opportunity <- mass[, 1]
-names(opportunity) <- rownames(mass)
-
-sij <- extract_opportunities(
- opportunity = opportunity,
- distance = distance2,
- check_names = TRUE
-)
-
-
-res <- run_law(
- law = "Schneider",
- mass_origin = mi,
- opportunity = sij,
- param = c(0.01,0.02)
-)
-
-res$parameter_1
-res$parameter_2
-
-
-
-res <- run_law(
- law = "Rad",
- mass_origin = mi,
- opportunity = sij
-)
-
-res$proba
-
-
-res <- run_law(
- law = "RadExt",
- mass_origin = mi,
- opportunity = sij,
- param = c(0.01,0.02)
-)
-
-res$parameter_1
-res$parameter_2
-
-proba <- res$proba
-
-for(i in proba %>% nrow %>% seq){
- proba[i,] <- (0.3 * proba[i,])/sum(proba[i,])
- proba[i,i] <- 0.7
- }