diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# ChangeLog + +## 0.0.1 (17 Oct 2019) + ++ Initial release of code. diff --git a/I1M.cabal b/I1M.cabal new file mode 100644 --- /dev/null +++ b/I1M.cabal @@ -0,0 +1,85 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 71104ec648548de9d9fa2500b9b7409bbcf0f97797b684f57363456c0658eeaf + +name: I1M +version: 0.0.1 +synopsis: Code for the Haskell course taught at the University od Seville. +description: 'En este paquete se encuentra los códigos de las librerías + desarrolladas en el curso de + + de 1º del Grado en Matemáticas de la Universidad de Sevilla.' +category: Education, Data Structures, Library +homepage: https://github.com/jaalonso/I1M +bug-reports: https://github.com/jaalonso/I1M/issues +author: Jose A. Alonso +maintainer: JoseA.Alonso@gmail.com +license: GPL-2 +license-file: LICENSE +tested-with: GHC==8.6.5 +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/jaalonso/I1M + +library + exposed-modules: + I1M.Pila + I1M.Cola + I1M.ColaDePrioridad + I1M.Conjunto + I1M.Tabla + I1M.ArbolBin + I1M.Monticulo + I1M.Pol + I1M.PolOperaciones + I1M.Grafo + I1M.RecorridoEnProfundidad + I1M.RecorridoEnAnchura + I1M.DivideVenceras + I1M.BusquedaEnEspaciosDeEstados + I1M.BusquedaPrimeroElMejor + I1M.BusquedaEnEscalada + I1M.Dinamica + I1M.Analizador + other-modules: + Paths_I1M + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + QuickCheck >=2.9.2 && <2.12.7 + , array >=0.5.0 && <0.5.4 + , base >=4.7 && <5 + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + ArbolBinPropiedades + ColaDePrioridadPropiedades + ColaPropiedades + ConjuntoPropiedades + MonticuloPropiedades + PilaPropiedades + PolOperacionesPropiedades + PolPropiedades + TablaPropiedades + Paths_I1M + hs-source-dirs: + test + build-depends: + I1M + , base >=4.7 && <5 + , tasty >=0.11 && <1.3 + , tasty-hunit >=0.9 && <0.10.1 + , tasty-quickcheck >=0.8 && <0.10.2 + default-language: Haskell2010 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,459 @@ +<<<<<<< HEAD + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. +======= +CC0 1.0 Universal + +Statement of Purpose + +The laws of most jurisdictions throughout the world automatically confer +exclusive Copyright and Related Rights (defined below) upon the creator and +subsequent owner(s) (each and all, an "owner") of an original work of +authorship and/or a database (each, a "Work"). + +Certain owners wish to permanently relinquish those rights to a Work for the +purpose of contributing to a commons of creative, cultural and scientific +works ("Commons") that the public can reliably and without fear of later +claims of infringement build upon, modify, incorporate in other works, reuse +and redistribute as freely as possible in any form whatsoever and for any +purposes, including without limitation commercial purposes. These owners may +contribute to the Commons to promote the ideal of a free culture and the +further production of creative, cultural and scientific works, or to gain +reputation or greater distribution for their Work in part through the use and +efforts of others. + +For these and/or other purposes and motivations, and without any expectation +of additional consideration or compensation, the person associating CC0 with a +Work (the "Affirmer"), to the extent that he or she is an owner of Copyright +and Related Rights in the Work, voluntarily elects to apply CC0 to the Work +and publicly distribute the Work under its terms, with knowledge of his or her +Copyright and Related Rights in the Work and the meaning and intended legal +effect of CC0 on those rights. + +1. Copyright and Related Rights. A Work made available under CC0 may be +protected by copyright and related or neighboring rights ("Copyright and +Related Rights"). Copyright and Related Rights include, but are not limited +to, the following: + + i. the right to reproduce, adapt, distribute, perform, display, communicate, + and translate a Work; + + ii. moral rights retained by the original author(s) and/or performer(s); + + iii. publicity and privacy rights pertaining to a person's image or likeness + depicted in a Work; + + iv. rights protecting against unfair competition in regards to a Work, + subject to the limitations in paragraph 4(a), below; + + v. rights protecting the extraction, dissemination, use and reuse of data in + a Work; + + vi. database rights (such as those arising under Directive 96/9/EC of the + European Parliament and of the Council of 11 March 1996 on the legal + protection of databases, and under any national implementation thereof, + including any amended or successor version of such directive); and + + vii. other similar, equivalent or corresponding rights throughout the world + based on applicable law or treaty, and any national implementations thereof. + +2. Waiver. To the greatest extent permitted by, but not in contravention of, +applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and +unconditionally waives, abandons, and surrenders all of Affirmer's Copyright +and Related Rights and associated claims and causes of action, whether now +known or unknown (including existing as well as future claims and causes of +action), in the Work (i) in all territories worldwide, (ii) for the maximum +duration provided by applicable law or treaty (including future time +extensions), (iii) in any current or future medium and for any number of +copies, and (iv) for any purpose whatsoever, including without limitation +commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes +the Waiver for the benefit of each member of the public at large and to the +detriment of Affirmer's heirs and successors, fully intending that such Waiver +shall not be subject to revocation, rescission, cancellation, termination, or +any other legal or equitable action to disrupt the quiet enjoyment of the Work +by the public as contemplated by Affirmer's express Statement of Purpose. + +3. Public License Fallback. Should any part of the Waiver for any reason be +judged legally invalid or ineffective under applicable law, then the Waiver +shall be preserved to the maximum extent permitted taking into account +Affirmer's express Statement of Purpose. In addition, to the extent the Waiver +is so judged Affirmer hereby grants to each affected person a royalty-free, +non transferable, non sublicensable, non exclusive, irrevocable and +unconditional license to exercise Affirmer's Copyright and Related Rights in +the Work (i) in all territories worldwide, (ii) for the maximum duration +provided by applicable law or treaty (including future time extensions), (iii) +in any current or future medium and for any number of copies, and (iv) for any +purpose whatsoever, including without limitation commercial, advertising or +promotional purposes (the "License"). The License shall be deemed effective as +of the date CC0 was applied by Affirmer to the Work. Should any part of the +License for any reason be judged legally invalid or ineffective under +applicable law, such partial invalidity or ineffectiveness shall not +invalidate the remainder of the License, and in such case Affirmer hereby +affirms that he or she will not (i) exercise any of his or her remaining +Copyright and Related Rights in the Work or (ii) assert any associated claims +and causes of action with respect to the Work, in either case contrary to +Affirmer's express Statement of Purpose. + +4. Limitations and Disclaimers. + + a. No trademark or patent rights held by Affirmer are waived, abandoned, + surrendered, licensed or otherwise affected by this document. + + b. Affirmer offers the Work as-is and makes no representations or warranties + of any kind concerning the Work, express, implied, statutory or otherwise, + including without limitation warranties of title, merchantability, fitness + for a particular purpose, non infringement, or the absence of latent or + other defects, accuracy, or the present or absence of errors, whether or not + discoverable, all to the greatest extent permissible under applicable law. + + c. Affirmer disclaims responsibility for clearing rights of other persons + that may apply to the Work or any use thereof, including without limitation + any person's Copyright and Related Rights in the Work. Further, Affirmer + disclaims responsibility for obtaining any necessary consents, permissions + or other rights required for any use of the Work. + + d. Affirmer understands and acknowledges that Creative Commons is not a + party to this document and has no duty or obligation with respect to this + CC0 or use of the Work. + +For more information, please see + + +>>>>>>> f4c456fc01f81d9e70527a0843ab61afcad90396 diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,34 @@ +En este repositorio se encuentra el código en Haskell de las librerías desarrolladas y +usadas en el curso de +[Informática de 1º del Grado en Matemáticas](https://www.cs.us.es/~jalonso/cursos/i1m-18) +de la Universidad de Sevilla. + +La documentación se puede consultar [aquí](http://jaalonso.github.io/I1M/). + +Las librerías incluidas son: + ++ Tipos abstractos de datos: + + [TAD de las pilas](https://jaalonso.github.io/I1M/I1M-Pila.html) + + [TAD de las colas](https://jaalonso.github.io/I1M/I1M-Cola.html) + + [TAD de las colas de prioridad](https://jaalonso.github.io/I1M/I1M-ColaDePrioridad.html) + + [TAD de los conjuntos](https://jaalonso.github.io/I1M/I1M-Conjunto.html) + + [TAD de las tablas](https://jaalonso.github.io/I1M/I1M-Tabla.html) + + [TAD de los árboles binarios de búsqueda](https://jaalonso.github.io/I1M/I1M-ArbolBin.html) + + [TAD de los montículos](https://jaalonso.github.io/I1M/I1M-Monticulo.html) + + Polinomios: + + [TAD de los polinomios](https://jaalonso.github.io/I1M/I1M-Pol.html) + + [Operaciones con el TAD de los polinomios](https://jaalonso.github.io/I1M/I1M-PolOperaciones.html) + + Grafos: + + [TAD de los grafos](https://jaalonso.github.io/I1M/I1M-Grafo.html) + + [Recorrido de grafos en profundidad](https://jaalonso.github.io/I1M/I1M-RecorridoEnProfundidad.html) + + [Recorrido de grafos en anchura](https://jaalonso.github.io/I1M/I1M-RecorridoEnAnchura.html) ++ Patrones de diseño: + + [Divide y vencerás](https://jaalonso.github.io/I1M/I1M-DivideVenceras.html) + + [Búsqueda en espacios de estados](https://jaalonso.github.io/I1M/I1M-BusquedaEnEspaciosDeEstados.html) + + [Búsqueda por primero el mejor](https://jaalonso.github.io/I1M/I1M-BusquedaPrimeroElMejor.html) + + [Búsqueda en escalada](https://jaalonso.github.io/I1M/I1M-BusquedaEnEscalada.html) + + [Programación dinámica](https://jaalonso.github.io/I1M/I1M-Dinamica.html) ++ Analizadores: + + [Analizadores funcionales](https://jaalonso.github.io/I1M/I1M-Analizador.html) + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/I1M/Analizador.hs b/src/I1M/Analizador.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Analizador.hs @@ -0,0 +1,342 @@ +-- | +-- Module : Analizador +-- Description : Analizadores sintácticos de expresiones aritméticas. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = Analizadores sintácticos de expresiones aritméticas. +-- +-- Este módulo contiene la definición de los analizadores sintácticos de +-- expresiones aritméticas estudiados en el +-- del curso. + +module I1M.Analizador + ( -- * El tipo de los analizadores + Analizador + , analiza + -- * Analizadores básicos + , resultado + , fallo + , elemento + -- * Secuenciación + , (>*>) + -- * Elección + , (+++) + -- * Primitivas derivadas + , sat + , digito + , minuscula + , mayuscula + , letra + , alfanumerico + , caracter + , cadena + , varios + , varios1 + , ident + , nat + , espacio + -- * Tratamiento de espacios + , unidad + , identificador + , natural + , simbolo + , listaNat + -- * Expresiones aritméticas + , expr + , valor + ) where + +import Data.Char + +-- --------------------------------------------------------------------- +-- § El tipo de los analizadores -- +-- --------------------------------------------------------------------- + +-- | El tipo de los analizadores. +type Analizador a = String -> [(a,String)] + +-- | (analiza a cs) es el resultado de aplicar el analizador a a la +-- cadena cs. +analiza :: Analizador a -> String -> [(a,String)] +analiza a = a + +-- --------------------------------------------------------------------- +-- § Analizadores básicos -- +-- --------------------------------------------------------------------- + +-- | El analizador (resultado v`) siempre tiene éxito, devuelve v y no +-- consume nada. Por ejemplo, +-- +-- > analiza (resultado 3) "Hola" == [(3,"Hola")] +resultado :: a -> Analizador a +resultado v = \ent -> [(v,ent)] + +-- | El analizador @fallo@ siempre falla. Por ejemplo, +-- +-- > analiza fallo "Hola" == [] +fallo :: Analizador a +fallo = \_ -> [] + +-- | El analizador @elemento@ falla si la cadena es vacía y consume el primer +-- elemento en caso contrario. Por ejemplo, +-- +-- > analiza elemento "Hola" == [('H',"ola")] +-- > analiza elemento "" == [] +elemento :: Analizador Char +elemento = \xs -> case xs of + [] -> [] + (y:ys) -> [(y,ys)] + +-- --------------------------------------------------------------------- +-- § Secuenciación -- +-- --------------------------------------------------------------------- + +-- | ((p >*> f) e) falla si el análisis de e por p falla, en caso +-- contrario, se obtiene un valor (v) y una salida (s), se aplica la +-- función f al valor v obteniéndose un nuevo analizador con el que se +-- analiza la salida s. +infixr 5 >*> + +(>*>) :: Analizador a -> (a -> Analizador b) -> Analizador b +p >*> f = \ent -> case analiza p ent of + [] -> [] + [(v,sal)] -> analiza (f v) sal + _ -> error "Imposible" + +-- --------------------------------------------------------------------- +-- § Elección -- +-- --------------------------------------------------------------------- + +-- | ((p +++ q) e) analiza e con p y si falla analiza e con q. Por +-- ejemplo, +-- +-- > analiza (elemento +++ resultado 'd') "abc" == [('a',"bc")] +-- > analiza (fallo +++ resultado 'd') "abc" == [('d',"abc")] +-- > analiza (fallo +++ fallo) "abc" == [] +(+++) :: Analizador a -> Analizador a -> Analizador a +p +++ q = \ent -> case analiza p ent of + [] -> analiza q ent + [(v,sal)] -> [(v,sal)] + _ -> error "Imposible" + +-- --------------------------------------------------------------------- +-- Primitivas derivadas -- +-- --------------------------------------------------------------------- + +-- | (sat p) es el analizador que consume un elemento si dicho elemento +-- cumple la propiedad p y falla en caso contrario. Por ejemplo, +-- +-- > analiza (sat isLower) "hola" == [('h',"ola")] +-- > analiza (sat isLower) "Hola" == [] +sat :: (Char -> Bool) -> Analizador Char +sat p = elemento >*> \x -> + if p x then resultado x else fallo + +-- | @digito@ analiza si el primer carácter es un dígito. Por ejemplo, +-- +-- > analiza digito "123" == [('1',"23")] +-- > analiza digito "uno" == [] +digito :: Analizador Char +digito = sat isDigit + +-- | @`minuscula@ analiza si el primer carácter es una letra +-- minúscula. Por ejemplo, +-- +-- > analiza minuscula "eva" == [('e',"va")] +-- > analiza minuscula "Eva" == [] +minuscula :: Analizador Char +minuscula = sat isLower + +-- | @mayuscula@ analiza si el primer carácter es una letra +-- mayúscula. Por ejemplo, +-- +-- > analiza mayuscula "Eva" == [('E',"va")] +-- > analiza mayuscula "eva" == [] +mayuscula :: Analizador Char +mayuscula = sat isUpper + +-- | @letra@ analiza si el primer carácter es una letra. Por ejemplo, +-- +-- > analiza letra "Eva" == [('E',"va")] +-- > analiza letra "eva" == [('e',"va")] +-- > analiza letra "123" == [] +letra :: Analizador Char +letra = sat isAlpha + +-- | @alfanumerico@ analiza si el primer carácter es una letra o un +-- número. Por ejemplo, +-- +-- > analiza alfanumerico "Eva" == [('E',"va")] +-- > analiza alfanumerico "eva" == [('e',"va")] +-- > analiza alfanumerico "123" == [('1',"23")] +-- > analiza alfanumerico " 123" == [] +alfanumerico :: Analizador Char +alfanumerico = sat isAlphaNum + +-- | @(caracter x)@ analiza si el primer carácter es igual al carácter +-- x. Por ejemplo, +-- +-- > analiza (caracter 'E') "Eva" == [('E',"va")] +-- > analiza (caracter 'E') "eva" == [] +caracter :: Char -> Analizador Char +caracter x = sat (== x) + +-- | @(cadena c)@ analiza si empieza con la cadena c. Por ejemplo, +-- +-- > analiza (cadena "abc") "abcdef" == [("abc","def")] +-- > analiza (cadena "abc") "abdcef" == [] +cadena :: String -> Analizador String +cadena [] = resultado [] +cadena (x:xs) = caracter x >*> \y -> + cadena xs >*> \ys -> + resultado (y:ys) + +-- | (varios p) aplica el analizador p cero o más veces. Por ejemplo, +-- +-- > analiza (varios digito) "235abc" == [("235","abc")] +-- > analiza (varios digito) "abc235" == [("","abc235")] +varios :: Analizador a -> Analizador [a] +varios p = varios1 p +++ resultado [] + +-- | (varios1 p) aplica el analizador p una o más veces. Por ejemplo, +-- +-- > analiza (varios1 digito) "235abc" == [("235","abc")] +-- > analiza (varios1 digito) "abc235" == [] +varios1 :: Analizador a -> Analizador [a] +varios1 p = p >*> \v -> + varios p >*> \vs -> + resultado (v:vs) + +-- | @ident@ analiza si comienza con un identificador (i.e. una cadena que +-- comienza con una letra minúscula seguida por caracteres +-- alfanuméricos). Por ejemplo, +-- +-- > analiza ident "lunes12 de Ene" == [("lunes12"," de Ene")] +-- > analiza ident "Lunes12 de Ene" == [] +ident :: Analizador String +ident = minuscula >*> \x -> + varios alfanumerico >*> \xs -> + resultado (x:xs) + +-- | @nat@ analiza si comienza con un número natural. Por ejemplo, +-- +-- > analiza nat "14DeAbril" == [(14,"DeAbril")] +-- > analiza nat " 14DeAbril" == [] +nat :: Analizador Int +nat = varios1 digito >*> \xs -> + resultado (read xs) + +-- | @espacio@ analiza si comienza con espacios en blanco. Por ejemplo, +-- +-- > analiza espacio " a b c" == [((),"a b c")] +espacio :: Analizador () +espacio = varios (sat isSpace) >*> \_ -> + resultado () + +-- --------------------------------------------------------------------- +-- § Tratamiento de espacios -- +-- --------------------------------------------------------------------- + +-- | (unidad p) ignora los espacios en blanco y aplica el analizador +-- `p`. Por ejemplo, +-- +-- > analiza (unidad nat) " 14DeAbril" == [(14,"DeAbril")] +-- > analiza (unidad nat) " 14 DeAbril" == [(14,"DeAbril")] +unidad :: Analizador a -> Analizador a +unidad p = espacio >*> \_ -> + p >*> \v -> + espacio >*> \_ -> + resultado v + +-- | @identificador@ analiza un identificador ignorando los espacios +-- delante y detrás. Por ejemplo, +-- +-- > analiza identificador " lunes12 de Ene" == [("lunes12","de Ene")] +identificador :: Analizador String +identificador = unidad ident + +-- | @natural@ analiza un número natural ignorando los espacios delante +-- y detrás. Por ejemplo, +-- +-- > analiza natural " 14DeAbril" == [(14,"DeAbril")] +natural :: Analizador Int +natural = unidad nat + +-- | (simbolo xs) analiza la cadena `xs` ignorando los espacios delante +-- y detrás. Por ejemplo, +-- +-- > analiza (simbolo "abc") " abcdef" == [("abc","def")] +simbolo :: String -> Analizador String +simbolo xs = unidad (cadena xs) + +-- | @listaNat@ analiza una lista de naturales ignorando los +-- espacios. Por ejemplo, +-- +-- > analiza listaNat " [ 2, 3, 5 ]" == [([2,3,5],"")] +-- > analiza listaNat " [ 2, 3,]" == [] +listaNat :: Analizador [Int] +listaNat = simbolo "[" >*> \_ -> + natural >*> \n -> + varios (simbolo "," >*> \_ -> + natural) >*> \ns -> + simbolo "]" >*> \_ -> + resultado (n:ns) + +-- --------------------------------------------------------------------- +-- § Expresiones aritméticas -- +-- --------------------------------------------------------------------- + +-- | @expr@ analiza una expresión aritmética devolviendo su valor. Por +-- ejemplo, +-- +-- > analiza expr "2*3+5" == [(11,"")] +-- > analiza expr "2*(3+5)" == [(16,"")] +-- > analiza expr "2+3*5" == [(17,"")] +-- > analiza expr "2*3+5abc" == [(11,"abc")] +expr :: Analizador Int +expr = term >*> \t -> + (simbolo "+" >*> \_ -> + expr >*> \e -> + resultado (t+e)) + +++ (simbolo "-" >*> \_ -> + expr >*> \e -> + resultado (t-e)) + +++ resultado t + +-- analiza term "2*3+5" == [(6,"+5")] +term :: Analizador Int +term = factor >*> \f -> + (simbolo "*" >*> \_ -> + term >*> \t -> + resultado (f*t)) + +++ (simbolo "/" >*> \_ -> + term >*> \t -> + resultado (f `div` t)) + +++ resultado f + +-- analiza factor "2*3+5" == [(2,"*3+5")] +-- analiza factor "(2+3)*5" == [(5,"*5")] +-- analiza factor "(2+3*7)*5" == [(23,"*5")] +factor :: Analizador Int +factor = (simbolo "(" >*> \_ -> + expr >*> \e -> + simbolo ")" >*> \_ -> + resultado e) + +++ natural + +-- | (valor cs) analiza la cadena cs devolviendo su valor si es una +-- expresión aritmética y un mensaje de error en caso contrario. Por +-- ejemplo, +-- +-- > valor "2*3+5" == 11 +-- > valor "2*(3+5)" == 16 +-- > valor "2 * 3 + 5" == 11 +-- > valor "2*3x+5y" == *** Exception: entrada sin usar x+5y +-- > valor "-1" == *** Exception: entrada no valida +valor :: String -> Int +valor xs = case (analiza expr xs) of + [(n,[])] -> n + [(_,sal)] -> error ("entrada sin usar " ++ sal) + [] -> error "entrada no valida" + _ -> error "Imposible" diff --git a/src/I1M/ArbolBin.hs b/src/I1M/ArbolBin.hs new file mode 100644 --- /dev/null +++ b/src/I1M/ArbolBin.hs @@ -0,0 +1,186 @@ +-- | +-- Module : ArbolBin +-- Description : TAD de los árboles binarios de búsqueda. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- == TAD (tipo abstracto de datos) de los árboles binarios de búsqueda. +-- +-- Este módulo contiene el código del TAD de los árboles binarios +-- estudiado en el del curso. +-- +-- Un árbol binario de búsqueda (ABB) es un árbol binario tal que el +-- valor de cada nodo es mayor que los valores de su subárbol izquierdo +-- y es menor que los valores de su subárbol derecho y, además, ambos +-- subárboles son árboles binarios de búsqueda. Por ejemplo, al +-- almacenar los valores de [2,3,4,5,6,8,9] en un ABB se puede obtener +-- los siguientes ABB: +-- +-- > 5 5 +-- > / \ / \ +-- > / \ / \ +-- > 2 6 3 8 +-- > \ \ / \ / \ +-- > 4 8 2 4 6 9 +-- > / \ +-- > 3 9 +-- +-- El objetivo principal de los ABB es reducir el tiempo de acceso a los +-- valores. +-- +-- En los ejemplos se usarán los siguientes ABB: +-- +-- > abb1, abb2 :: ABB Int +-- > abb1 = crea (reverse [5,2,6,4,8,3,9]) +-- > abb2 = foldr inserta vacio (reverse [5,2,4,3,8,6,7,10,9,11]) + +module I1M.ArbolBin + (ABB, + vacio, -- ABB + inserta, -- (Ord a,Show a) => a -> ABB a -> ABB a + elimina, -- (Ord a,Show a) => a -> ABB a -> ABB a + crea, -- (Ord a,Show a) => [a] -> ABB a + crea', -- (Ord a,Show a) => [a] -> ABB a + menor, -- Ord a => ABB a -> a + elementos, -- (Ord a,Show a) => ABB a -> [a] + pertenece, -- (Ord a,Show a) => a -> ABB a -> Bool + valido -- (Ord a,Show a) => ABB a -> Bool + ) where + +-- | El tipo de dato de los ABB, +data ABB a = Vacio + | Nodo a (ABB a) (ABB a) + deriving Eq + +-- Procedimiento de escritura de árboles binarios de búsqueda. +instance (Show a, Ord a) => Show (ABB a) where + show Vacio = " -" + show (Nodo x i d) = " (" ++ show x ++ show i ++ show d ++ ")" + +-- Ejemplos de ABB +-- ghci> abb1 +-- (5 (2 - (4 (3 - -) -)) (6 - (8 - (9 - -)))) +-- ghci> abb2 +-- (5 (2 - (4 (3 - -) -)) (8 (6 - (7 - -)) (10 (9 - -) (11 - -)))) +-- abb1, abb2 :: ABB Int +-- abb1 = crea (reverse [5,2,6,4,8,3,9]) +-- abb2 = foldr inserta vacio (reverse [5,2,4,3,8,6,7,10,9,11]) + +-- | vacio es el ABB vacío. Por ejemplo, +-- +-- > ghci> vacio +-- > - +vacio :: ABB a +vacio = Vacio + +-- | (pertenece v' a) se verifica si v' es el valor de algún nodo del ABB +-- a. Por ejemplo, +-- +-- > pertenece 3 abb1 == True +-- > pertenece 7 abb1 == False +pertenece :: (Ord a,Show a) => a -> ABB a -> Bool +pertenece _ Vacio = False +pertenece v' (Nodo v i d) + | v == v' = True + | v' < v = pertenece v' i + | otherwise = pertenece v' d + +-- pertenece requiere O(n) paso en el peor caso O(n) y O(log n) en el mejor, +-- donde n es el número de nodos del ABB. + +-- | (inserta v a) es el árbol obtenido añadiendo el valor v al ABB a, si +-- no es uno de sus valores. Por ejemplo, +-- +-- > ghci> inserta 7 abb1 +-- > (5 (2 - (4 (3 - -) -)) (6 - (8 (7 - -) (9 - -)))) +inserta :: (Ord a,Show a) => a -> ABB a -> ABB a +inserta v' Vacio = Nodo v' Vacio Vacio +inserta v' (Nodo v i d) + | v' == v = Nodo v i d + | v' < v = Nodo v (inserta v' i) d + | otherwise = Nodo v i (inserta v' d) + +-- inserta requiere O(n) pasos en el peor caso y O(log n) en el mejor. + +-- | (crea vs) es el ABB cuyos valores son vs. Por ejemplo, +-- +-- > ghci> crea [3,7,2] +-- > (2 - (7 (3 - -) -)) +crea :: (Ord a,Show a) => [a] -> ABB a +crea = foldr inserta Vacio + +-- | (crea' vs) es el ABB de menor profundidad cuyos valores son los de +-- la lista ordenada vs. Por ejemplo, +-- +-- > ghci> crea' [2,3,7] +-- > (3 (2 - -) (7 - -)) +crea' :: (Ord a,Show a) => [a] -> ABB a +crea' [] = Vacio +crea' vs = Nodo x (crea' l1) (crea' l2) + where n = length vs `div` 2 + l1 = take n vs + (x:l2) = drop n vs + +-- | (elementos a) es la lista de los valores de los nodos del ABB en el +-- recorrido inorden. Por ejemplo, +-- +-- > elementos abb1 == [2,3,4,5,6,8,9] +-- > elementos abb2 == [2,3,4,5,6,7,8,9,10,11] +elementos :: (Ord a,Show a) => ABB a -> [a] +elementos Vacio = [] +elementos (Nodo v i d) = elementos i ++ [v] ++ elementos d + +-- | (elimina v a) es el ABB obtenido borrando el valor v del ABB a. Por +-- ejemplo, +-- +-- > ghci> abb1 +-- > (5 (2 - (4 (3 - -) -)) (6 - (8 - (9 - -)))) +-- > ghci> elimina 3 abb1 +-- > (5 (2 - (4 - -)) (6 - (8 - (9 - -)))) +-- > ghci> elimina 2 abb1 +-- > (5 (4 (3 - -) -) (6 - (8 - (9 - -)))) +-- > ghci> elimina 5 abb1 +-- > (6 (2 - (4 (3 - -) -)) (8 - (9 - -))) +-- > ghci> elimina 7 abb1 +-- > (5 (2 - (4 (3 - -) -)) (6 - (8 - (9 - -)))) +elimina :: (Ord a,Show a) => a -> ABB a -> ABB a +elimina _ Vacio = Vacio +elimina v' (Nodo v i Vacio) | v'==v = i +elimina v' (Nodo v Vacio d) | v'==v = d +elimina v' (Nodo v i d) + | v' < v = Nodo v (elimina v' i) d + | v' > v = Nodo v i (elimina v' d) + | otherwise = Nodo k i (elimina k d) + where k = menor d + +-- | (menor a) es el mínimo valor del ABB a. Por ejemplo, +-- +-- > menor abb1 == 2 +menor :: Ord a => ABB a -> a +menor (Nodo v Vacio _) = v +menor (Nodo _ i _) = menor i +menor Vacio = error "No tiene" + +-- | (menorTodos v a) se verifica si v es menor que todos los elementos +-- del ABB a. +menorTodos :: (Ord a, Show a) => a -> ABB a -> Bool +menorTodos _ Vacio = True +menorTodos v a = v < minimum (elementos a) + +-- | (mayorTodos v a) se verifica si v es mayor que todos los elementos +-- del ABB a. +mayorTodos :: (Ord a, Show a) => a -> ABB a -> Bool +mayorTodos _ Vacio = True +mayorTodos v a = v > maximum (elementos a) + +-- | (valido a) se verifica si a es un ABB correcto. Por ejemplo, +-- +-- > valido abb1 == True +valido :: (Ord a, Show a) => ABB a -> Bool +valido Vacio = True +valido (Nodo v a b) = + mayorTodos v a && + menorTodos v b && + valido a && + valido b + diff --git a/src/I1M/BusquedaEnEscalada.hs b/src/I1M/BusquedaEnEscalada.hs new file mode 100644 --- /dev/null +++ b/src/I1M/BusquedaEnEscalada.hs @@ -0,0 +1,44 @@ +-- | +-- Module : BusquedaEnEscalada +-- Description : El patrón de búsqueda en escalada. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El patrón de búsqueda en escalada +-- +-- Este módulo contiene la definición del patrón de búsqueda en escalada +-- estudiado en el del curso. +-- +-- Además, en el tema se incluye como de casos de aplicación del patrón +-- +-- * y +-- * . + +module I1M.BusquedaEnEscalada (buscaEscalada) where + +-- --------------------------------------------------------------------- +-- Importaciones -- +-- --------------------------------------------------------------------- + +import I1M.ColaDePrioridad + +-- --------------------------------------------------------------------- +-- El patrón de búsqueda en escalada -- +-- --------------------------------------------------------------------- + +-- | (buscaEscalada s o e) es la lista de soluciones del problema de espacio de +-- estado definido por la función sucesores (s), el objetivo (o) y el +-- estado inicial (e), obtenidas buscando por escalada. +buscaEscalada :: Ord nodo => + (nodo -> [nodo]) -- sucesores + -> (nodo -> Bool) -- es final + -> nodo -- nodo actual + -> [nodo] -- soluciones +buscaEscalada sucesores esFinal x = busca' (inserta x vacia) + where + busca' c + | esVacia c = [] + | esFinal (primero c) = [primero c] + | otherwise = + busca' (foldr inserta vacia (sucesores (primero c))) diff --git a/src/I1M/BusquedaEnEspaciosDeEstados.hs b/src/I1M/BusquedaEnEspaciosDeEstados.hs new file mode 100644 --- /dev/null +++ b/src/I1M/BusquedaEnEspaciosDeEstados.hs @@ -0,0 +1,66 @@ +-- | +-- Module : BusquedaEnEspaciosDeEstados +-- Description : El patrón de búsqueda en espacios de estados. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El patrón de búsqueda en espacios de estados +-- +-- Las características de los problemas de espacios de estados son: +-- +-- * un conjunto de las posibles situaciones o nodos que constituye +-- el espacio de estados; estos son las potenciales soluciones que se +-- necesitan explorar; +-- * un conjunto de movimientos de un nodo a otros nodos, llamados los +-- sucesores del nodo; +-- * un nodo inicial; +-- * un nodo objetivo, que es la solución. +-- +-- Este módulo contiene la definición del patrón de búsqueda en espacios +-- de estados estudiado en el del +-- curso. Además, en el tema se incluye dos casos de aplicación del patrón: +-- +-- * y +-- * . + +module I1M.BusquedaEnEspaciosDeEstados (buscaEE) where + +-- --------------------------------------------------------------------- +-- Importaciones -- +-- --------------------------------------------------------------------- + +import I1M.Pila + +-- --------------------------------------------------------------------- +-- Descripción de los problemas de espacios de estados -- +-- --------------------------------------------------------------------- + +-- Las características de los problemas de espacios de estados son: +-- * un conjunto de las posibles situaciones o nodos que constituye +-- el espacio de estados; estos son las potenciales soluciones que se +-- necesitan explorar; +-- * un conjunto de movimientos de un nodo a otros nodos, llamados los +-- sucesores del nodo; +-- * un nodo inicial; +-- * un nodo objetivo, que es la solución. + +-- --------------------------------------------------------------------- +-- El patrón de búsqueda en espacios de estados -- +-- --------------------------------------------------------------------- + +-- Nota: Se supone que el grafo implícito de espacios de estados es +-- acíclico. + +-- | (buscaEE s o e) es la lista de soluciones del problema de espacio de +-- estado definido por la función sucesores (s), el objetivo (o) y el +-- estado inicial (e). +buscaEE:: (Eq nodo) => (nodo -> [nodo]) -- sucesores + -> (nodo -> Bool) -- esFinal + -> nodo -- nodo actual + -> [nodo] -- soluciones +buscaEE sucesores esFinal x = busca' (apila x vacia) + where + busca' p + | esVacia p = [] + | esFinal (cima p) = cima p : busca' (desapila p) + | otherwise = busca' (foldr apila (desapila p) (sucesores (cima p))) diff --git a/src/I1M/BusquedaPrimeroElMejor.hs b/src/I1M/BusquedaPrimeroElMejor.hs new file mode 100644 --- /dev/null +++ b/src/I1M/BusquedaPrimeroElMejor.hs @@ -0,0 +1,41 @@ +-- | +-- Module : BusquedaPrimeroElMejor +-- Description : El patrón de búsqueda por primero el mejor. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El patrón de búsqueda por primero el mejor +-- +-- Este módulo contiene la definición del patrón de búsqueda por primero +-- el mejor estudiado en el del +-- curso. +-- +-- Además, en el tema se incluye como de aplicación del patrón el +-- . + +module I1M.BusquedaPrimeroElMejor (buscaPM) where + +-- --------------------------------------------------------------------- +-- Importaciones -- +-- --------------------------------------------------------------------- + +import I1M.ColaDePrioridad + +-- --------------------------------------------------------------------- +-- Búsqueda por primero el mejor -- +-- --------------------------------------------------------------------- + +-- | (buscaPM s o e) es la lista de soluciones del problema de espacio de +-- estado definido por la función sucesores (s), el objetivo (o) y el +-- estado inicial (e), obtenidas buscando por primero el mejor. +buscaPM :: (Ord nodo) => + (nodo -> [nodo]) -- sucesores + -> (nodo -> Bool) -- esFinal + -> nodo -- nodo actual + -> [nodo] -- solución +buscaPM sucesores esFinal x = busca' (inserta x vacia) + where + busca' c + | esVacia c = [] + | esFinal (primero c) = primero c : busca' (resto c) + | otherwise = busca' (foldr inserta (resto c) (sucesores (primero c))) diff --git a/src/I1M/Cola.hs b/src/I1M/Cola.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Cola.hs @@ -0,0 +1,73 @@ +-- | +-- Module : Cola +-- Description : TAD de las colas. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de las colas. +-- +-- Este módulo contiene el código del TAD de las colas +-- estudiado en el del curso. + +module I1M.Cola + (Cola, + vacia, -- Cola a + inserta, -- a -> Cola a -> Cola a + primero, -- Cola a -> a + resto, -- Cola a -> Cola a + esVacia, -- Cola a -> Bool + valida -- Cola a -> Bool + ) where + +-- | Tipo de las colas. +newtype Cola a = C [a] + deriving (Show, Eq) + +-- | c1 es un ejemplo de cola que se usará en los siguientes ejemplos. +-- +-- > ghci> c1 +-- > C [10,9,8,7,6,5,4,3,2,1] +-- c1 = foldr inserta vacia [1..10] + +-- | vacia es la cola vacía. Por ejemplo, +-- +-- > ghci> vacia +-- > C [] +vacia :: Cola a +vacia = C [] + +-- | (inserta x c) es la cola obtenida añadiendo x al final de la cola +-- c. Por ejemplo, +-- +-- > inserta 12 (foldr inserta vacia [1..10]) == C [10,9,8,7,6,5,4,3,2,1,12] +inserta :: a -> Cola a -> Cola a +inserta x (C c) = C (c ++ [x]) + +-- Nota: La operación inserta usa O(n) pasos. + +-- | (primero c) es el primer elemento de la cola c. Por ejemplo, +-- +-- > primero (foldr inserta vacia [1..10]) == 10 +primero :: Cola a -> a +primero (C (x:_)) = x +primero (C []) = error "primero: cola vacia" + +-- | (resto c) es la cola obtenida eliminando el primer elemento de la +-- cola c. Por ejemplo, +-- +-- > resto (foldr inserta vacia [1..10]) == C [9,8,7,6,5,4,3,2,1] +resto :: Cola a -> Cola a +resto (C (_:xs)) = C xs +resto (C []) = error "resto: cola vacia" + +-- | (esVacia c) se verifica si c es la cola vacía. Por ejemplo, +-- +-- > esVacia (foldr inserta vacia [1..10]) == False +-- > esVacia vacia == True +esVacia :: Cola a -> Bool +esVacia (C xs) = null xs + +-- | (valida c) se verifica si c representa una cola válida. Con esta +-- representación, todas las colas son válidas. +valida :: Cola a -> Bool +valida _ = True diff --git a/src/I1M/ColaDePrioridad.hs b/src/I1M/ColaDePrioridad.hs new file mode 100644 --- /dev/null +++ b/src/I1M/ColaDePrioridad.hs @@ -0,0 +1,97 @@ +-- | +-- Module : ColaDePrioridad +-- Description : TAD de las colas de prioridad. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de las colas de prioridad. +-- +-- Este módulo contiene el código del TAD de las colas de prioridad +-- estudiado en el del curso. + +module I1M.ColaDePrioridad + (CPrioridad, + vacia, -- Ord a => CPrioridad a + inserta, -- Ord a => a -> CPrioridad a -> CPrioridad a + primero, -- Ord a => CPrioridad a -> a + resto, -- Ord a => CPrioridad a -> CPrioridad a + esVacia, -- Ord a => CPrioridad a -> Bool + valida -- Ord a => CPrioridad a -> Bool + ) where + +import qualified I1M.Monticulo as M + +-- | Tipo de datos de las colas de prioridad. +newtype CPrioridad a = CP (M.Monticulo a) + deriving (Eq, Show) + +-- Ejemplo de cola de prioridad +-- ghci> foldr inserta vacia [3,1,7,2,9] +-- CP (M 1 2 +-- (M 2 2 +-- (M 9 1 VacioM VacioM) +-- (M 7 1 VacioM VacioM)) +-- (M 3 1 VacioM VacioM)) +-- cp1 :: CPrioridad Int +-- cp1 = foldr inserta vacia [3,1,7,2,9] + +-- | vacia es la cola de prioridad vacía. Por ejemplo, +-- +-- > vacia == CP Vacio +vacia :: Ord a => CPrioridad a +vacia = CP M.vacio + +-- | (inserta x c) añade el elemento x a la cola de prioridad c. Por ejemplo, +-- +-- > ghci> foldr inserta vacia [3,1,7,2,9] +-- > CP (M 1 2 +-- > (M 2 2 +-- > (M 9 1 VacioM VacioM) +-- > (M 7 1 VacioM VacioM)) +-- > (M 3 1 VacioM VacioM)) +-- > ghci> inserta 5 (foldr inserta vacia [3,1,7,2,9]) +-- > CP (M 1 2 +-- > (M 2 2 +-- > (M 9 1 VacioM VacioM) +-- > (M 7 1 VacioM VacioM)) +-- > (M 3 1 +-- > (M 5 1 VacioM VacioM) VacioM)) +inserta :: Ord a => a -> CPrioridad a -> CPrioridad a +inserta v (CP c) = CP (M.inserta v c) + +-- | (primero c) es la cabeza de la cola de prioridad c. Por ejemplo, +-- +-- > primero (foldr inserta vacia [3,1,7,2,9]) == 1 +primero :: Ord a => CPrioridad a -> a +primero (CP c) = M.menor c + +-- | (resto c) elimina la cabeza de la cola de prioridad c. Por ejemplo, +-- +-- > ghci> (foldr inserta vacia [3,1,7,2,9]) +-- > CP (M 1 2 +-- > (M 2 2 +-- > (M 9 1 VacioM VacioM) +-- > (M 7 1 VacioM VacioM)) +-- > (M 3 1 VacioM VacioM)) +-- > ghci> resto (foldr inserta vacia [3,1,7,2,9]) +-- > CP (M 2 2 +-- > (M 9 1 VacioM VacioM) +-- > (M 3 1 +-- > (M 7 1 VacioM VacioM) VacioM)) +resto :: Ord a => CPrioridad a -> CPrioridad a +resto (CP c) = CP (M.resto c) + +-- | (esVacia c) se verifica si la cola de prioridad c es vacía. Por +-- ejemplo, +-- +-- > esVacia (foldr inserta vacia [3,1,7,2,9]) == False +-- > esVacia vacia == True +esVacia :: Ord a => CPrioridad a -> Bool +esVacia (CP c) = M.esVacio c + +-- | (valida c) se verifica si c es una cola de prioridad válida. En la +-- representación mediante montículo todas las colas de prioridad son +-- válidas. +valida :: Ord a => CPrioridad a -> Bool +valida _ = True + diff --git a/src/I1M/Conjunto.hs b/src/I1M/Conjunto.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Conjunto.hs @@ -0,0 +1,100 @@ +-- | +-- Module : Conjunto +-- Description : TAD de los conjuntos. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de los conjuntos. +-- +-- Este módulo contiene el código del TAD de los conjuntos +-- estudiado en el del curso. + +module I1M.Conjunto + (Conj, + vacio, -- Conj a + esVacio, -- Conj a -> Bool + pertenece, -- Ord a => a -> Conj a -> Bool + inserta, -- Ord a => a -> Conj a -> Conj a + elimina -- Ord a => a -> Conj a -> Conj a + ) where + +-- | Tipo de dato de los conjuntos. +newtype Conj a = Cj [a] + deriving Eq + +-- Procedimiento de escritura de los conjuntos. +instance (Show a) => Show (Conj a) where + showsPrec _ (Cj s) = showConj s + +showConj :: Show a => [a] -> String -> String +showConj [] cad = showString "{}" cad +showConj (x:xs) cad = showChar '{' (shows x (showl xs cad)) + where showl [] cs = showChar '}' cs + showl (y:ys) cs = showChar ',' (shows y (showl ys cs)) + +-- En los ejemplos se usará el siguiente conjunto. +-- +-- > ghci> c1 +-- > {0,1,2,3,5,7,9} +-- c1 :: Conj Int +-- c1 = foldr inserta vacio [2,5,1,3,7,5,3,2,1,9,0] + +-- | vacio es el conjunto vacío. Por ejemplo, +-- +-- > ghci> vacio +-- > {} +vacio :: Conj a +vacio = Cj [] + +-- | (esVacio c) se verifica si c es el conjunto vacío. Por ejemplo, +-- +-- > λ> esVacio (foldr inserta vacio [2,5]) +-- > False +-- > λ> esVacio vacio +-- > True +esVacio :: Conj a -> Bool +esVacio (Cj xs) = null xs + +-- | (pertenece x c) se verifica si x pertenece al conjunto c. Por ejemplo, +-- +-- > λ> let c1 = foldr inserta vacio [2,5,3,2] +-- > λ> pertenece 3 c1 +-- > True +-- > λ> pertenece 4 c1 +-- > False +pertenece :: Ord a => a -> Conj a -> Bool +pertenece x (Cj s) = x `elem` takeWhile (<= x) s + +-- | (inserta x c) es el conjunto obtenido añadiendo el elemento x al +-- conjunto c. Por ejemplo, +-- +-- > λ> let c1 = foldr inserta vacio [2,5,3,2] +-- > λ> c1 +-- > {2,3,5} +-- > λ> inserta 3 c1 +-- > {2,3,5} +-- > λ> inserta 4 c1 +-- > {2,3,4,5} +inserta :: Ord a => a -> Conj a -> Conj a +inserta x (Cj s) = Cj (agrega x s) + where agrega x' [] = [x'] + agrega x' s'@(y:ys) | x' > y = y : agrega x' ys + | x' < y = x' : s' + | otherwise = s' + +-- | (elimina x c) es el conjunto obtenido eliminando el elemento x +-- del conjunto c. Por ejemplo, +-- +-- > λ> let c1 = foldr inserta vacio [2,5,3,2] +-- > λ> c1 +-- > {2,3,5} +-- > λ> elimina 3 c1 +-- > {2,5} +-- > λ> elimina 7 c1 +-- > {2,3,5} +elimina :: Ord a => a -> Conj a -> Conj a +elimina x (Cj s) = Cj (elimina' x s) + where elimina' _ [] = [] + elimina' x' s'@(y:ys') | x' > y = y : elimina' x' ys' + | x' < y = s' + | otherwise = ys' diff --git a/src/I1M/Dinamica.hs b/src/I1M/Dinamica.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Dinamica.hs @@ -0,0 +1,30 @@ +-- | +-- Module : Dinamica +-- Description : El patrón de programación dinámica. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El patrón de programación dinámica +-- +-- Este módulo contiene la definición del patrón de programación dinámica +-- estudiado en el del curso. +-- +-- Además, en el tema se incluye como de casos de aplicación del patrón +-- +-- * , +-- * , +-- * , +-- * y +-- * < http://bit.ly/1Isv0 el problema del viajante>. + +module I1M.Dinamica (module I1M.Tabla, dinamica) where + +import I1M.Tabla +import Data.Array + +-- | (dinamica f r) wa la tabla de cálculo dinámica de la función f en +-- el rango r. +dinamica :: Ix i => (Tabla i v -> i -> v) -> (i,i) -> Tabla i v +dinamica calcula cotas = t + where t = tabla [(i,calcula t i) | i <- range cotas] diff --git a/src/I1M/DivideVenceras.hs b/src/I1M/DivideVenceras.hs new file mode 100644 --- /dev/null +++ b/src/I1M/DivideVenceras.hs @@ -0,0 +1,58 @@ +-- | +-- Module : DivideVenceras +-- Description : El patrón "divide y vencerás". +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El patrón "divide y vencerás" +-- +-- La técnica "divide y vencerás" consta de los siguientes pasos: +-- +-- 1. Dividir el problema en subproblemas menores. +-- 2. Resolver por separado cada uno de los subproblemas; si los +-- subproblemas son complejos, usar la misma técnica recursivamente; +-- si son simples, resolverlos directamente. +-- 3. Combinar todas las soluciones de los subproblemas en una solución +-- simple. +-- +-- Este módulo contiene la definición del patrón "divide y vencerás" +-- estudiado en el del curso. Además, en +-- el tema se incluye dos casos de aplicación del patrón: +-- +-- * y +-- * . + +module I1M.DivideVenceras (divideVenceras) where + +-- --------------------------------------------------------------------- +-- El patrón de diseño "divide y vencerás" -- +-- --------------------------------------------------------------------- + +-- La técnica "divide y vencerás" consta de los siguientes pasos: +-- 1. Dividir el problema en subproblemas menores. +-- 2. Resolver por separado cada uno de los subproblemas; si los +-- subproblemas son complejos, usar la misma técnica recursivamente; +-- si son simples, resolverlos directamente. +-- 3. Combinar todas las soluciones de los subproblemas en una solución +-- simple. + +-- | (divideVenceras ind resuelve divide combina pbInicial) resuelve el +-- problema pbInicial mediante la técnica de divide y vencerás, donde +-- +-- * (ind pb) se verifica si el problema pb es indivisible +-- * (resuelve pb) es la solución del problema indivisible pb +-- * (divide pb) es la lista de subproblemas de pb +-- * (combina pb ss) es la combinación de las soluciones ss de los +-- subproblemas del problema pb. +-- * pbInicial es el problema inicial +divideVenceras :: + (p -> Bool) + -> (p -> s) + -> (p -> [p]) + -> (p -> [s] -> s) + -> p + -> s +divideVenceras ind resuelve divide combina = dv' where + dv' pb + | ind pb = resuelve pb + | otherwise = combina pb [dv' sp | sp <- divide pb] diff --git a/src/I1M/Grafo.hs b/src/I1M/Grafo.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Grafo.hs @@ -0,0 +1,163 @@ +-- | +-- Module : Grafos +-- Description : TAD de los grafos. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = El TAD (tipo abstracto de datos) de los grafos +-- +-- Este módulo contiene el código del TAD de los grafos +-- estudiado en el del curso. +-- +-- En los ejemplos se usarán los siguientes grafos: +-- +-- > 12 +-- > 1 -------- 2 +-- > | \78 /| +-- > | \ 32/ | +-- > | \ / | +-- > 34| 5 |55 +-- > | / \ | +-- > | /44 \ | +-- > | / 93\| +-- > 3 -------- 4 +-- > 61 +-- definido por +-- +-- > ejGrafoND = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78), +-- > (2,4,55),(2,5,32), +-- > (3,4,61),(3,5,44), +-- > (4,5,93)] +-- y el mismo grafo que ejGrafoND pero orientando las aristas; +-- +-- > ejGrafoD = creaGrafo D (1,5) [(1,2,12),(1,3,34),(1,5,78), +-- > (2,4,55),(2,5,32), +-- > (3,4,61),(3,5,44), +-- > (4,5,93)] + +module I1M.Grafo + (Orientacion (..), + Grafo, + creaGrafo, -- (Ix v,Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> + -- Grafo v p + dirigido, -- (Ix v,Num p) => (Grafo v p) -> Bool + adyacentes, -- (Ix v,Num p) => (Grafo v p) -> v -> [v] + nodos, -- (Ix v,Num p) => (Grafo v p) -> [v] + aristas, -- (Ix v,Num p) => (Grafo v p) -> [(v,v,p)] + aristaEn, -- (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool + peso -- (Ix v,Num p) => v -> v -> (Grafo v p) -> p + ) where + +-- --------------------------------------------------------------------- +-- Librerías auxiliares -- +-- --------------------------------------------------------------------- + +import Data.Array + +-- | Orientacion es D (dirigida) ó ND (no dirigida). +data Orientacion = D | ND + deriving (Eq, Show) + +-- | (Grafo v p) es un grafo con vértices de tipo v y pesos de tipo p. +data Grafo v p = G Orientacion (Array v [(v,p)]) + deriving (Eq, Show) + +-- | (creaGrafo o cs as) es un grafo (dirigido o no, según el valor de o), +-- con el par de cotas cs y listas de aristas as (cada arista es un trío +-- formado por los dos vértices y su peso). Ver el ejemplo a continuación. +creaGrafo :: (Ix v, Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> Grafo v p +creaGrafo o cs vs = + G o (accumArray + (\xs x -> xs++[x]) [] cs + ((if o == D then [] + else [(x2,(x1,p))|(x1,x2,p) <- vs, x1 /= x2]) ++ + [(x1,(x2,p)) | (x1,x2,p) <- vs])) + +-- ejGrafoND es el grafo +-- 12 +-- 1 -------- 2 +-- | \78 /| +-- | \ 32/ | +-- | \ / | +-- 34| 5 |55 +-- | / \ | +-- | /44 \ | +-- | / 93\| +-- 3 -------- 4 +-- 61 +-- representado mediante un vector de adyacencia; es decir, +-- ghci> ejGrafoND +-- G ND array (1,5) [(1,[(2,12),(3,34),(5,78)]), +-- (2,[(1,12),(4,55),(5,32)]), +-- (3,[(1,34),(4,61),(5,44)]), +-- (4,[(2,55),(3,61),(5,93)]), +-- (5,[(1,78),(2,32),(3,44),(4,93)])]) +-- ejGrafoND = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78), +-- (2,4,55),(2,5,32), +-- (3,4,61),(3,5,44), +-- (4,5,93)] + +-- ejGrafoD es el mismo grafo que ejGrafoND pero orientando las aristas; +-- es decir, +-- ghci> ejGrafoD +-- G D array (1,5) [(1,[(2,12),(3,34),(5,78)]), +-- (2,[(4,55),(5,32)]), +-- (3,[(4,61),(5,44)]), +-- (4,[(5,93)]), +-- (5,[])]) +-- ejGrafoD = creaGrafo D (1,5) [(1,2,12),(1,3,34),(1,5,78), +-- (2,4,55),(2,5,32), +-- (3,4,61),(3,5,44), +-- (4,5,93)] + +-- | (dirigido g) se verifica si g es dirigido. Por ejemplo, +-- +-- > dirigido ejGrafoD == True +-- > dirigido ejGrafoND == False +dirigido :: (Ix v,Num p) => Grafo v p -> Bool +dirigido (G o _) = o == D + +-- | (nodos g) es la lista de todos los nodos del grafo g. Por ejemplo, +-- +-- > nodos ejGrafoND == [1,2,3,4,5] +-- > nodos ejGrafoD == [1,2,3,4,5] +nodos :: (Ix v,Num p) => Grafo v p -> [v] +nodos (G _ g) = indices g + +-- | (adyacentes g v) es la lista de los vértices adyacentes al nodo v en +-- el grafo g. Por ejemplo, +-- +-- > adyacentes ejGrafoND 4 == [2,3,5] +-- > adyacentes ejGrafoD 4 == [5] +adyacentes :: (Ix v,Num p) => Grafo v p -> v -> [v] +adyacentes (G _ g) v = map fst (g!v) + +-- | (aristaEn g a) se verifica si a es una arista del grafo g. Por +-- ejemplo, +-- +-- > aristaEn ejGrafoND (5,1) == True +-- > aristaEn ejGrafoND (4,1) == False +-- > aristaEn ejGrafoD (5,1) == False +-- > aristaEn ejGrafoD (1,5) == True +aristaEn :: (Ix v,Num p) => Grafo v p -> (v,v) -> Bool +aristaEn g (x,y) = y `elem` adyacentes g x + +-- | (peso v1 v2 g) es el peso de la arista que une los vértices v1 y v2 +-- en el grafo g. Por ejemplo, +-- +-- > peso 1 5 ejGrafoND == 78 +-- > peso 1 5 ejGrafoD == 78 +peso :: (Ix v,Num p) => v -> v -> Grafo v p -> p +peso x y (G _ g) = head [c | (a,c) <- g!x , a == y] + +-- | (aristas g) es la lista de las aristas del grafo g. Por ejemplo, +-- +-- > ghci> aristas ejGrafoD +-- > [(1,2,12),(1,3,34),(1,5,78),(2,4,55),(2,5,32),(3,4,61), +-- > (3,5,44),(4,5,93)] +-- > ghci> aristas ejGrafoND +-- > [(1,2,12),(1,3,34),(1,5,78),(2,1,12),(2,4,55),(2,5,32), +-- > (3,1,34),(3,4,61),(3,5,44),(4,2,55),(4,3,61),(4,5,93), +-- > (5,1,78),(5,2,32),(5,3,44),(5,4,93)] +aristas :: (Ix v,Num p) => Grafo v p -> [(v,v,p)] +aristas (G o g) = [(v1,v2,w) | v1 <- nodos (G o g) , (v2,w) <- g!v1] diff --git a/src/I1M/Monticulo.hs b/src/I1M/Monticulo.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Monticulo.hs @@ -0,0 +1,188 @@ +-- | +-- Module : Monticulo +-- Description : TAD de los montículos. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de los montículos. +-- +-- Este módulo contiene el código del TAD de los montículos +-- estudiado en el del curso. +-- +-- Un montículo es un árbol binario en el que los valores de cada nodo es +-- menor o igual que los valores de sus hijos. Por ejemplo, +-- 1 +-- / \ +-- / \ +-- 2 6 +-- / \ / \ +-- 3 8 9 7 +-- es un montículo, pero +-- 1 +-- / \ +-- / \ +-- 3 6 +-- / \ / \ +-- 4 2 9 7 +-- no lo es. + +module I1M.Monticulo + (Monticulo, + vacio, -- Ord a => Monticulo a + inserta, -- Ord a => a -> Monticulo a -> Monticulo a + menor, -- Ord a => Monticulo a -> a + resto, -- Ord a => Monticulo a -> Monticulo a + esVacio, -- Ord a => Monticulo a -> Bool + valido -- Ord a => Monticulo a -> Bool + ) where + +import Data.List (sort) + +-- | El tipo de dato de los montículos. +data Monticulo a = Vacio + | M a Int (Monticulo a) (Monticulo a) + deriving Show + +-- Ejemplos de montículos +-- ghci> m1 +-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio) +-- ghci> m2 +-- M 5 1 (M 7 1 Vacio Vacio) Vacio +-- ghci> m3 +-- M 1 2 +-- (M 5 2 +-- (M 7 1 Vacio Vacio) +-- (M 6 1 Vacio Vacio)) +-- (M 4 1 +-- (M 8 1 Vacio Vacio) +-- Vacio) +-- Gráficamente +-- m1 m2 m3 +-- +-- (1,2) +-- (1,2) (5,1) / \ +-- / \ / / \ +-- (4,1) (6,1) (7,1) (5,2) (4,1) +-- / / \ / +-- (8,1) (7,1) (6,1) (8,1) +-- m1, m1', m2, m3 :: Monticulo Int +-- m1 = foldr inserta vacio [6,1,4,8] +-- m1' = foldr inserta vacio [6,8,4,1] +-- m2 = foldr inserta vacio [7,5] +-- m3 = mezcla m1 m2 + +-- | vacio es el montículo vacío. +vacio :: Ord a => Monticulo a +vacio = Vacio + +-- | (rango m) es el rango del montículo m; es decir, la menor distancia +-- a un montículo vacío. Por ejemplo, +-- +-- > rango (foldr inserta vacio [6,1,4,8]) == 2 +-- > rango (foldr inserta vacio [7,5]) == 1 +rango :: Ord a => Monticulo a -> Int +rango Vacio = 0 +rango (M _ r _ _) = r + +-- | (creaM x a b) es el montículo creado a partir del elemento x y los +-- montículos a y b. Se supone que x es menor o igual que el mínimo de +-- a y de b. Por ejemplo, +-- +-- > ghci> creaM 0 (foldr inserta vacio [6,1,4,8]) (foldr inserta vacio [7,5]) +-- > M 0 2 (M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)) +-- > (M 5 1 (M 7 1 Vacio Vacio) Vacio) +-- > ghci> creaM 0 (foldr inserta vacio [7,5]) (foldr inserta vacio [6,1,4,8]) +-- > M 0 2 (M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)) +-- > (M 5 1 (M 7 1 Vacio Vacio) Vacio) +creaM :: Ord a => a -> Monticulo a -> Monticulo a -> Monticulo a +creaM x a b | rango a >= rango b = M x (rango b + 1) a b + | otherwise = M x (rango a + 1) b a + +-- | (mezcla m1 m2) es el montículo obtenido mezclando los montículos m1 y +-- m2. Por ejemplo, +-- +-- > ghci> mezcla (foldr inserta vacio [6,1,4,8]) (foldr inserta vacio [7,5]) +-- > M 1 2 +-- > (M 5 2 +-- > (M 7 1 Vacio Vacio) +-- > (M 6 1 Vacio Vacio)) +-- > (M 4 1 +-- > (M 8 1 Vacio Vacio) +-- > Vacio) +mezcla :: Ord a => Monticulo a -> Monticulo a -> Monticulo a +mezcla m Vacio = m +mezcla Vacio m = m +mezcla m1@(M x _ a1 b1) m2@(M y _ a2 b2) + | x <= y = creaM x a1 (mezcla b1 m2) + | otherwise = creaM y a2 (mezcla m1 b2) + +-- | (inserta x m) es el montículo obtenido añadiendo el elemento x al +-- montículo m. Por ejemplo, +-- +-- > ghci> inserta 3 (foldr inserta vacio [6,1,4,8]) +-- > M 1 2 +-- > (M 4 1 (M 8 1 Vacio Vacio) Vacio) +-- > (M 3 1 (M 6 1 Vacio Vacio) Vacio) +inserta :: Ord a => a -> Monticulo a -> Monticulo a +inserta x = mezcla (M x 1 Vacio Vacio) + +-- | (menor m) es el menor elemento del montículo m. Por ejemplo, +-- +-- > menor (foldr inserta vacio [6,1,4,8]) == 1 +-- > menor (foldr inserta vacio [7,5]) == 5 +menor :: Ord a => Monticulo a -> a +menor (M x _ _ _) = x +menor Vacio = error "menor: monticulo vacio" + +-- | (resto m) es el montículo obtenido eliminando el menor elemento del +-- montículo m. Por ejemplo, +-- +-- > ghci> resto (foldr inserta vacio [6,1,4,8]) +-- > M 4 2 (M 8 1 Vacio Vacio) (M 6 1 Vacio Vacio) +resto :: Ord a => Monticulo a -> Monticulo a +resto Vacio = error "resto: monticulo vacio" +resto (M _ _ a b) = mezcla a b + +-- | (esVacio m) se verifica si m es el montículo vacío. +esVacio :: Ord a => Monticulo a -> Bool +esVacio Vacio = True +esVacio _ = False + +-- | (valido m) se verifica si m es un montículo; es decir, es un árbol +-- binario en el que los valores de cada nodo es menor o igual que los +-- valores de sus hijos. Por ejemplo, +-- +-- > valido (foldr inserta vacio [6,1,4,8]) == True +-- > valido (foldr inserta vacio [7,5]) == True +-- > valido (M 3 5 (M 2 1 Vacio Vacio) Vacio) == False +valido :: Ord a => Monticulo a -> Bool +valido Vacio = True +valido (M _ _ Vacio Vacio) = True +valido (M x _ m1@(M x1 _ _ _) Vacio) = + x <= x1 && valido m1 +valido (M x _ Vacio m2@(M x2 _ _ _)) = + x <= x2 && valido m2 +valido (M x _ m1@(M x1 _ _ _) m2@(M x2 _ _ _)) = + x <= x1 && valido m1 && + x <= x2 && valido m2 + +-- | (elementos m) es la lista de los elementos del montículo m. Por +-- ejemplo, +-- +-- > elementos (foldr inserta vacio [6,1,4,8]) == [1,4,8,6] +elementos :: Ord a => Monticulo a -> [a] +elementos Vacio = [] +elementos (M x _ a b) = x : elementos a ++ elementos b + +-- | (equivMonticulos m1 m2) se verifica si los montículos m1 y m2 tienen +-- los mismos elementos. Por ejemplo, +-- +-- > ghci> equivMonticulos (foldr inserta vacio [6,1,4]) (foldr inserta vacio [6,4,1]) +-- > True +equivMonticulos :: Ord a => Monticulo a -> Monticulo a -> Bool +equivMonticulos m1 m2 = + sort (elementos m1) == sort (elementos m2) + +-- Los montículos son comparables por igualdad. +instance Ord a => Eq (Monticulo a) where + (==) = equivMonticulos diff --git a/src/I1M/Pila.hs b/src/I1M/Pila.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Pila.hs @@ -0,0 +1,73 @@ +-- | +-- Module : Pila +-- Description : TAD de las pilas. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de las pilas. +-- +-- Este módulo contiene el código del TAD de las pilas +-- estudiado en el del curso. + +module I1M.Pila + (Pila, + vacia, -- Pila a + apila, -- a -> Pila a -> Pila a + cima, -- Pila a -> a + desapila, -- Pila a -> Pila a + esVacia -- Pila a -> Bool + ) where + +-- | Tipo de dato de las pilas. +data Pila a = Vacia + | P a (Pila a) + deriving Eq + +-- Procedimiento de escritura de pilas. +instance (Show a) => Show (Pila a) where + showsPrec _ Vacia cad = showChar '-' cad + showsPrec _ (P x s) cad = shows x (showChar '|' (shows s cad)) + +-- | p1 es un ejemplo de pila que se usará en los siguientes ejemplos: +-- +-- > ghci> p1 +-- > 1|2|3|- +-- p1 :: Pila Int +-- p1 = apila 1 (apila 2 (apila 3 vacia)) + +-- | vacia es la pila vacía. Por ejemplo, +-- +-- > ghci> vacia +-- > - +vacia :: Pila a +vacia = Vacia + +-- | (apila x p) es la pila obtenida añadiendo x encima de la pila p. Por +-- ejemplo, +-- +-- > apila 4 (apila 1 (apila 2 (apila 3 vacia))) == 4|1|2|3|- +apila :: a -> Pila a -> Pila a +apila = P + +-- | (cima p) es la cima de la pila p. Por ejemplo, +-- +-- > cima (apila 1 (apila 2 (apila 3 vacia))) == 1 +cima :: Pila a -> a +cima Vacia = error "la pila vacia no tiene cima" +cima (P x _) = x + +-- | (desapila p) es la pila obtenida suprimiendo la cima de la pila +-- p. Por ejemplo, +-- +-- > desapila (apila 1 (apila 2 (apila 3 vacia))) == 2|3|- +desapila :: Pila a -> Pila a +desapila Vacia = error "no se puede desapila la pila vacia" +desapila (P _ p) = p + +-- | (esVacia p) se verifica si p es la pila vacía. Por ejemplo, +-- +-- > esVacia (apila 1 (apila 2 (apila 3 vacia))) == False +-- > esVacia vacia == True +esVacia :: Pila a -> Bool +esVacia Vacia = True +esVacia _ = False diff --git a/src/I1M/Pol.hs b/src/I1M/Pol.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Pol.hs @@ -0,0 +1,165 @@ +-- | +-- Module : Pol +-- Description : TAD de los polinomios. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = TAD (tipo abstracto de datos) de los polinomios +-- +-- Este módulo contiene el código del TAD de los polinomios +-- estudiado en el del curso. +-- +-- En los ejemplos se usarán los siguientes polinomios: +-- +-- > ejPol1, ejPol2, ejPol3:: Polinomio Int +-- > ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- > ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- > ejPol3 = consPol 4 6 (consPol 1 2 polCero) +-- > ejPol5, ejPol6, ejPol7:: Polinomio Float +-- > ejPol5 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- > ejPol6 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- > ejPol7 = consPol 1 2 (consPol 4 6 polCero) +-- +-- Su escritura es +-- +-- > ejPol1 == 3*x^4 + -5*x^2 + 3 +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > ejPol3 == 6*x^4 + 2*x +-- > ejPol5 == 3.0*x^4 + -5.0*x^2 + 3.0 +-- > ejPol6 == x^5 + 5.0*x^2 + 4.0*x +-- > ejPol7 == 6.0*x^4 + 2.0*x + +module I1M.Pol + ( Polinomio, + polCero, -- Polinomio a + esPolCero, -- Polinomio a -> Bool + consPol, -- (Num a, Eq a)) => Int -> a -> Polinomio a -> Polinomio a + grado, -- Polinomio a -> Int + coefLider, -- Num t => Polinomio t -> t + restoPol -- Polinomio t -> Polinomio t + ) where + +-- --------------------------------------------------------------------- +-- TAD de los polinomios mediante un tipo de dato algebraico. -- +-- --------------------------------------------------------------------- + +-- Representamos un polinomio mediante los constructores ConsPol y +-- PolCero. Por ejemplo, el polinomio +-- 6x^4 -5x^2 + 4x -7 +-- se representa por +-- ConsPol 4 6 (ConsPol 2 (-5) (ConsPol 1 4 (ConsPol 0 (-7) PolCero))) + +-- | Tipo de dato de polinomios. +data Polinomio a = PolCero + | ConsPol Int a (Polinomio a) + deriving Eq + +-- --------------------------------------------------------------------- +-- Escritura de los polinomios -- +-- --------------------------------------------------------------------- + +instance (Num a, Show a, Eq a) => Show (Polinomio a) where + show PolCero = "0" + show (ConsPol 0 b PolCero) = show b + show (ConsPol 0 b p) = concat [show b, " + ", show p] + show (ConsPol 1 b PolCero) = show b ++ "*x" + show (ConsPol 1 b p) = concat [show b, "*x + ", show p] + show (ConsPol n 1 PolCero) = "x^" ++ show n + show (ConsPol n b PolCero) = concat [show b, "*x^", show n] + show (ConsPol n 1 p) = concat ["x^", show n, " + ", show p] + show (ConsPol n b p) = concat [show b, "*x^", show n, " + ", show p] + +-- --------------------------------------------------------------------- +-- Ejemplos de polinomios -- +-- --------------------------------------------------------------------- + +-- Ejemplos de polinomios con coeficientes enteros: +-- ejPol1, ejPol2, ejPol3:: Polinomio Int +-- ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- ejPol3 = consPol 4 6 (consPol 1 2 polCero) + +-- Comprobación de escritura: +-- > ejPol1 +-- 3*x^4 + -5*x^2 + 3 +-- > ejPol2 +-- x^5 + 5*x^2 + 4*x +-- > ejPol3 +-- 6*x^4 + 2*x + +-- Ejemplos de polinomios con coeficientes reales: +-- ejPol5, ejPol6, ejPol7:: Polinomio Float +-- ejPol5 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- ejPol6 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- ejPol7 = consPol 1 2 (consPol 4 6 polCero) + +-- Comprobación de escritura: +-- > ejPol5 +-- 3.0*x^4 + -5.0*x^2 + 3.0 +-- > ejPol6 +-- x^5 + 5.0*x^2 + 4.0*x +-- > ejPol7 +-- 6.0*x^4 + 2.0*x + +-- --------------------------------------------------------------------- +-- Implementación de la especificación -- +-- --------------------------------------------------------------------- + +-- | polCero es el polinomio cero. Por ejemplo, +-- +-- > > polCero +-- > 0 +polCero :: Polinomio a +polCero = PolCero + +-- | (esPolCero p) se verifica si p es el polinomio cero. Por ejemplo, +-- +-- > esPolCero polCero == True +-- > esPolCero ejPol1 == False +esPolCero :: Polinomio a -> Bool +esPolCero PolCero = True +esPolCero _ = False + +-- | (consPol n b p) es el polinomio bx^n+p. Por ejemplo, +-- +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > consPol 3 0 ejPol2 == x^5 + 5*x^2 + 4*x +-- > consPol 3 2 polCero == 2*x^3 +-- > consPol 6 7 ejPol2 == 7*x^6 + x^5 + 5*x^2 + 4*x +-- > consPol 4 7 ejPol2 == x^5 + 7*x^4 + 5*x^2 + 4*x +-- > consPol 5 7 ejPol2 == 8*x^5 + 5*x^2 + 4*x +consPol :: (Num a, Eq a) => Int -> a -> Polinomio a -> Polinomio a +consPol _ 0 p = p +consPol n b PolCero = ConsPol n b PolCero +consPol n b (ConsPol m c p) + | n > m = ConsPol n b (ConsPol m c p) + | n < m = ConsPol m c (consPol n b p) + | b+c == 0 = p + | otherwise = ConsPol n (b+c) p + +-- | (grado p) es el grado del polinomio p. Por ejemplo, +-- +-- > ejPol3 == 6*x^4 + 2*x +-- > grado ejPol3 == 4 +grado :: Polinomio a -> Int +grado PolCero = 0 +grado (ConsPol n _ _) = n + +-- | (coefLider p) es el coeficiente líder del polinomio p. Por ejemplo, +-- +-- > ejPol3 == 6*x^4 + 2*x +-- > coefLider ejPol3 == 6 +coefLider :: Num t => Polinomio t -> t +coefLider PolCero = 0 +coefLider (ConsPol _ b _) = b + +-- | (restoPol p) es el resto del polinomio p. Por ejemplo, +-- +-- > ejPol3 == 6*x^4 + 2*x +-- > restoPol ejPol3 == 2*x +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > restoPol ejPol2 == 5*x^2 + 4*x +restoPol :: Polinomio t -> Polinomio t +restoPol PolCero = PolCero +restoPol (ConsPol _ _ p) = p + diff --git a/src/I1M/PolOperaciones.hs b/src/I1M/PolOperaciones.hs new file mode 100644 --- /dev/null +++ b/src/I1M/PolOperaciones.hs @@ -0,0 +1,199 @@ +-- | +-- Module : PolOperaciones +-- Description : Operaciones con el TAD de los polinomios. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- En este módulo se definen operaciones con el TAD (tipo abstracto de +-- datos) de los polinomios estudiado en el +-- del curso. +-- +-- En los ejemplos se usarán los siguientes polinomios: +-- +-- > ejPol1, ejPol2, ejPol3, ejTerm:: Polinomio Int +-- > ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- > ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- > ejPol3 = consPol 4 6 (consPol 1 2 polCero) +-- > ejTerm = consPol 1 4 polCero + +module I1M.PolOperaciones + ( module I1M.Pol + -- * Funciones sobre términos + , creaTermino + , termLider + -- * Suma de polinomios + , sumaPol + -- * Producto de polinomios + , multPorTerm + , multPol + , polUnidad + -- * Valor de un polinomio en un punto + , valor + -- * Verificación de raices de polinomios + , esRaiz + -- * Derivación de polinomios + , derivada + -- * Resta de polinomios + , restaPol + ) where + +-- --------------------------------------------------------------------- +-- Importación de librerías -- +-- --------------------------------------------------------------------- + +import I1M.Pol + +-- --------------------------------------------------------------------- +-- Ejemplos -- +-- --------------------------------------------------------------------- + +-- Ejemplos de polinomios con coeficientes enteros: +-- ejPol1, ejPol2, ejPol3, ejTerm:: Polinomio Int +-- ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +-- ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +-- ejPol3 = consPol 4 6 (consPol 1 2 polCero) +-- ejTerm = consPol 1 4 polCero + +-- --------------------------------------------------------------------- +-- Funciones sobre términos +-- --------------------------------------------------------------------- + +-- | (creaTermino n a) es el término a*x^n. Por ejemplo, +-- +-- > creaTermino 2 5 == 5*x^2 +creaTermino :: (Num t, Eq t) => Int -> t -> Polinomio t +creaTermino n a = consPol n a polCero + +-- | (termLider p) es el término líder del polinomio p. Por ejemplo, +-- +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > termLider ejPol2 == x^5 +termLider :: (Num t, Eq t) => Polinomio t -> Polinomio t +termLider p = creaTermino (grado p) (coefLider p) + +-- --------------------------------------------------------------------- +-- Suma de polinomios -- +-- --------------------------------------------------------------------- + +-- | (sumaPol p q) es la suma de los polinomios p y q. Por ejemplo, +-- +-- > ejPol1 == 3*x^4 + -5*x^2 + 3 +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > sumaPol ejPol1 ejPol2 == x^5 + 3*x^4 + 4*x + 3 +sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a +sumaPol p q + | esPolCero p = q + | esPolCero q = p + | n1 > n2 = consPol n1 a1 (sumaPol r1 q) + | n1 < n2 = consPol n2 a2 (sumaPol p r2) + | otherwise = consPol n1 (a1+a2) (sumaPol r1 r2) + where n1 = grado p + a1 = coefLider p + r1 = restoPol p + n2 = grado q + a2 = coefLider q + r2 = restoPol q + +-- --------------------------------------------------------------------- +-- Producto de polinomios -- +-- --------------------------------------------------------------------- + +-- | (multPorTerm t p) es el producto del término t por el polinomio +-- p. Por ejemplo, +-- +-- > ejTerm == 4*x +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > multPorTerm ejTerm ejPol2 == 4*x^6 + 20*x^3 + 16*x^2 +multPorTerm :: (Num t, Eq t) => Polinomio t -> Polinomio t -> Polinomio t +multPorTerm term pol + | esPolCero pol = polCero + | otherwise = consPol (n+m) (a*b) (multPorTerm term r) + where n = grado term + a = coefLider term + m = grado pol + b = coefLider pol + r = restoPol pol + +-- | (multPol p q) es el producto de los polinomios p y q. Por +-- ejemplo, +-- +-- > ghci> ejPol1 +-- > 3*x^4 + -5*x^2 + 3 +-- > ghci> ejPol2 +-- > x^5 + 5*x^2 + 4*x +-- > ghci> multPol ejPol1 ejPol2 +-- > 3*x^9 + -5*x^7 + 15*x^6 + 15*x^5 + -25*x^4 + -20*x^3 + 15*x^2 + 12*x +multPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a +multPol p q + | esPolCero p = polCero + | otherwise = sumaPol (multPorTerm (termLider p) q) + (multPol (restoPol p) q) + +-- | polUnidad es el polinomio unidad. Por ejemplo, +-- +-- > ghci> polUnidad +-- > 1 +polUnidad:: (Num t, Eq t) => Polinomio t +polUnidad = consPol 0 1 polCero + +-- --------------------------------------------------------------------- +-- Valor de un polinomio en un punto -- +-- --------------------------------------------------------------------- + +-- | (valor p c) es el valor del polinomio p al sustituir su variable por +-- c. Por ejemplo, +-- +-- > ejPol1 == 3*x^4 + -5*x^2 + 3 +-- > valor ejPol1 0 == 3 +-- > valor ejPol1 1 == 1 +-- > valor ejPol1 (-2) == 31 +valor :: (Num a, Eq a) => Polinomio a -> a -> a +valor p c + | esPolCero p = 0 + | otherwise = b*c^n + valor r c + where n = grado p + b = coefLider p + r = restoPol p + +-- --------------------------------------------------------------------- +-- Verificación de raices de polinomios -- +-- --------------------------------------------------------------------- + +-- | (esRaiz c p) se verifica si c es una raiz del polinomio p. Por +-- ejemplo, +-- +-- > ejPol3 == 6*x^4 + 2*x +-- > esRaiz 1 ejPol3 == False +-- > esRaiz 0 ejPol3 == True +esRaiz :: (Num a, Eq a) => a -> Polinomio a -> Bool +esRaiz c p = valor p c == 0 + +-- --------------------------------------------------------------------- +-- Derivación de polinomios -- +-- --------------------------------------------------------------------- + +-- | (derivada p) es la derivada del polinomio p. Por ejemplo, +-- +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > derivada ejPol2 == 5*x^4 + 10*x + 4 +derivada :: (Eq a, Num a) => Polinomio a -> Polinomio a +derivada p + | n == 0 = polCero + | otherwise = consPol (n-1) (b * fromIntegral n) (derivada r) + where n = grado p + b = coefLider p + r = restoPol p + +-- --------------------------------------------------------------------- +-- Resta de polinomios -- +-- --------------------------------------------------------------------- + +-- | (resta p q) es el polinomio obtenido restándole a p el q. Por +-- ejemplo, +-- +-- > ejPol1 == 3*x^4 + -5*x^2 + 3 +-- > ejPol2 == x^5 + 5*x^2 + 4*x +-- > restaPol ejPol1 ejPol2 == -1*x^5 + 3*x^4 + -10*x^2 + -4*x + 3 +restaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a +restaPol p q = + sumaPol p (multPorTerm (creaTermino 0 (-1)) q) diff --git a/src/I1M/RecorridoEnAnchura.hs b/src/I1M/RecorridoEnAnchura.hs new file mode 100644 --- /dev/null +++ b/src/I1M/RecorridoEnAnchura.hs @@ -0,0 +1,72 @@ +-- | +-- Module : RecorridoEnAnchura +-- Description : Recorrido de grafos en anchura. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = Recorrido de grafos en anchura +-- +-- En los ejemplos se usará el siguiente grafo +-- +-- > +---> 2 <---+ +-- > | | +-- > | | +-- > 1 --> 3 --> 6 --> 5 +-- > | | +-- > | | +-- > +---> 4 <---------+ +-- definido por +-- > g = creaGrafo D (1,6) +-- > [(1,2,0),(1,3,0),(1,4,0),(3,6,0),(5,4,0),(6,2,0),(6,5,0)] + +module I1M.RecorridoEnAnchura (recorridoEnAnchura) where + +-- --------------------------------------------------------------------- +-- Librerías auxiliares -- +-- --------------------------------------------------------------------- + +import Data.Ix +import I1M.Grafo + +-- --------------------------------------------------------------------- +-- Ejemplo de grafo -- +-- --------------------------------------------------------------------- + +-- g es el grafo +-- +---> 2 <---+ +-- | | +-- | | +-- 1 --> 3 --> 6 --> 5 +-- | | +-- | | +-- +---> 4 <---------+ +-- g = creaGrafo D (1,6) +-- [(1,2,0),(1,3,0),(1,4,0),(3,6,0),(5,4,0),(6,2,0),(6,5,0)] + +-- --------------------------------------------------------------------- +-- Recorrido en anchura con colas -- +-- --------------------------------------------------------------------- + +-- | (recorridoEnAnchura i g) es el recorrido en anchura del grafo g +-- desde el vértice i, usando colas. Por ejemplo, +-- +-- > recorridoEnAnchura 1 g == [1,4,3,2,6,5] +recorridoEnAnchura :: (Num p, Ix v) => v -> Grafo v p -> [v] +recorridoEnAnchura i g = reverse (ra [i] []) where + ra [] vis = vis + ra (c:cs) vis + | c `elem` vis = ra cs vis + | otherwise = ra (cs ++ adyacentes g c) (c:vis) + +-- Traza del cálculo de (recorridoEnAnchura 1 g) +-- RecorridoEnAnchura 1 g +-- = ra [1] [] +-- = ra [2,3,4] [1] +-- = ra [3,4] [2,1] +-- = ra [4,6] [3,2,1] +-- = ra [6] [4,3,2,1] +-- = ra [2,5] [6,4,3,2,1] +-- = ra [5] [6,4,3,2,1] +-- = ra [4] [5,6,4,3,2,1] +-- = ra [] [5,6,4,3,2,1] +-- = [1,2,3,4,6,5] diff --git a/src/I1M/RecorridoEnProfundidad.hs b/src/I1M/RecorridoEnProfundidad.hs new file mode 100644 --- /dev/null +++ b/src/I1M/RecorridoEnProfundidad.hs @@ -0,0 +1,105 @@ +-- | +-- Module : RecorridoEnProfundidad +-- Description : Recorrido de grafos en profundidad. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- = Recorrido de grafos en profundidad +-- +-- En los ejemplos se usará el siguiente grafo +-- +-- > +---> 2 <---+ +-- > | | +-- > | | +-- > 1 --> 3 --> 6 --> 5 +-- > | | +-- > | | +-- > +---> 4 <---------+ +-- definido por +-- > g = creaGrafo D (1,6) +-- > [(1,2,0),(1,3,0),(1,4,0),(3,6,0),(5,4,0),(6,2,0),(6,5,0)] + +module I1M.RecorridoEnProfundidad (recorridoEnProfundidad, + recorridoEnProfundidad') where + +-- --------------------------------------------------------------------- +-- Librerías auxiliares -- +-- --------------------------------------------------------------------- + +import Data.Ix +import I1M.Grafo + +-- --------------------------------------------------------------------- +-- Ejemplo de grafo -- +-- --------------------------------------------------------------------- + +-- g es el grafo +-- +---> 2 <---+ +-- | | +-- | | +-- 1 --> 3 --> 6 --> 5 +-- | | +-- | | +-- +---> 4 <---------+ + +-- g = creaGrafo D (1,6) +-- [(1,2,0),(1,3,0),(1,4,0),(3,6,0),(5,4,0),(6,2,0),(6,5,0)] + +-- --------------------------------------------------------------------- +-- Recorrido en profundidad -- +-- --------------------------------------------------------------------- + +-- | (recorridoEnProfundidad i g) es el recorrido en profundidad del grafo g +-- desde el vértice i. Por ejemplo, +-- +-- > recorridoEnProfundidad 1 g == [1,2,3,6,5,4] +recorridoEnProfundidad :: (Num p, Ix v) => v -> Grafo v p -> [v] +recorridoEnProfundidad i g = rp [i] [] where + rp [] vis = vis + rp (c:cs) vis + | c `elem` vis = rp cs vis + | otherwise = rp (adyacentes g c ++ cs) (vis ++ [c]) + +-- Traza del cálculo de (recorridoEnProfundidad 1 g) +-- recorridoEnProfundidad 1 g +-- = rp [1] [] +-- = rp [2,3,4] [1] +-- = rp [3,4] [1,2] +-- = rp [6,4] [1,2,3] +-- = rp [2,5,4] [1,2,3,6] +-- = rp [5,4] [1,2,3,6] +-- = rp [4,4] [1,2,3,6,5] +-- = rp [4] [1,2,3,6,5,4] +-- = rp [] [1,2,3,6,5,4] +-- = [1,2,3,6,5,4] + +-- --------------------------------------------------------------------- +-- Recorrido en profundidad con acumuladores -- +-- --------------------------------------------------------------------- + +-- | (recorridoEnProfundidad' i g) es el recorrido en profundidad del +-- grafo g desde el vértice i, usando la lista de los visitados como +-- acumulador. Por ejemplo, +-- +-- > recorridoEnProfundidad' 1 g == [1,2,3,6,5,4] +recorridoEnProfundidad' :: (Num p, Ix v) => v -> Grafo v p -> [v] +recorridoEnProfundidad' i g = reverse (rp [i] []) where + rp [] vis = vis + rp (c:cs) vis + | c `elem` vis = rp cs vis + | otherwise = rp ( adyacentes g c ++ cs) (c : vis) + +-- Traza del cálculo de (recorridoEnProfundidad' 1 g) +-- RecorridoEnProfundidad' 1 g +-- = reverse (rp [1] []) +-- = reverse (rp [2,3,4] [1]) +-- = reverse (rp [3,4] [2,1]) +-- = reverse (rp [6,4] [3,2,1]) +-- = reverse (rp [2,5,4] [6,3,2,1]) +-- = reverse (rp [5,4] [6,3,2,1]) +-- = reverse (rp [4,4] [5,6,3,2,1]) +-- = reverse (rp [4] [4,5,6,3,2,1]) +-- = reverse (rp [] [4,5,6,3,2,1]) +-- = reverse [4,5,6,3,2,1] +-- = [1,2,3,6,5,4] + diff --git a/src/I1M/Tabla.hs b/src/I1M/Tabla.hs new file mode 100644 --- /dev/null +++ b/src/I1M/Tabla.hs @@ -0,0 +1,80 @@ +-- | +-- Module : Tabla +-- Description : TAD de las tablas. +-- License : Creative Commons +-- Maintainer : José A. Alonso +-- +-- TAD (tipo abstracto de datos) de las tablas. +-- +-- Este módulo contiene el código del TAD de las tablas +-- estudiado en el del curso. +-- +-- En los ejemplos se usarán las siguientes tablas: +-- +-- > t1 = tabla [(i,f i) | i <- [1..6] ] +-- > where f x | x < 3 = x +-- > | otherwise = 3-x +-- > t2 = tabla [(4,89), (1,90), (2,67)] + +module I1M.Tabla + (Tabla, + tabla, -- Eq i => [(i,v)] -> Tabla i v + valor, -- Eq i => Tabla i v -> i -> v + modifica -- Eq i => (i,v) -> Tabla i v -> Tabla i v + ) where + +-- | El tipo de las tablas. +newtype Tabla i v = Tbl [(i,v)] + deriving Show + +-- Ejemplos de tabla: +-- ghci> t1 +-- Tbl [(1,1),(2,2),(3,0),(4,-1),(5,-2),(6,-3)] +-- ghci> t2 +-- Tbl [(4,89),(1,90),(2,67)] +-- t1 = tabla [(i,f i) | i <- [1..6] ] +-- where f x | x < 3 = x +-- | otherwise = 3-x +-- t2 = tabla [(4,89), (1,90), (2,67)] + +-- | (tabla ivs) es la tabla correspondiente a la lista de asociación +-- ivs (que es una lista de pares formados por los índices y los +-- valores). Por ejemplo, +-- +-- > tabla [(4,89), (1,90), (2,67)] == Tbl [(4,89),(1,90),(2,67)] +tabla :: Eq i => [(i,v)] -> Tabla i v +tabla = Tbl + +-- | (valor t i) es el valor del índice i en la tabla t. Por ejemplo, +-- +-- > valor t1 6 == -3 +-- > valor t2 2 == 67 +-- > valor t2 5 == *** Exception: fuera de rango +valor :: Eq i => Tabla i v -> i -> v +valor (Tbl []) _ = error "fuera de rango" +valor (Tbl ((j,v):r)) i + | i == j = v + | otherwise = valor (Tbl r) i + +-- | (modifica (i,x) t) es la tabla obtenida modificando en la tabla t el +-- valor de i por x. Por ejemplo, +-- +-- > valor t1 6 == -3 +-- > valor (modifica (6,9) t1) 6 == 9 +modifica :: Eq i => (i,v) -> Tabla i v -> Tabla i v +modifica p (Tbl []) = Tbl [p] +modifica p'@(i,_) (Tbl (p@(j,_):r)) + | i == j = Tbl (p':r) + | otherwise = Tbl (p:r') + where Tbl r' = modifica p' (Tbl r) + +-- --------------------------------------------------------------------- +-- Igualdad -- +-- --------------------------------------------------------------------- + +--- Las tablas son comparables por igualdad. +instance (Eq i, Eq v) => Eq (Tabla i v) where + (Tbl []) == (Tbl []) = True + (Tbl ((i,v):t)) == Tbl t' = elem (i,v) t' && + Tbl t == Tbl [p | p <- t', p /= (i,v)] + _ == _ = error "No se da" diff --git a/test/ArbolBinPropiedades.hs b/test/ArbolBinPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/ArbolBinPropiedades.hs @@ -0,0 +1,296 @@ +-- ArbolBinPropiedades.hs +-- Generador de árboles binarios de búsqueda y propiedades del TAD. +-- José A. Alonso Jiménez +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module ArbolBinPropiedades (tests) where + +import I1M.ArbolBin +import Data.List +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de ABB -- +-- --------------------------------------------------------------------- + +-- genABB es un generador de árboles binarios de búsqueda. Por ejemplo, +-- ghci> sample genABB +-- - +-- (1 (-1 - -) -) +-- (1 - -) +-- (-1 (-3 - -) (1 - (4 - -))) +-- - +-- (10 (-7 - -) -) +-- (1 (-9 - -) (7 (5 - -) (10 - -))) +-- ... +genABB :: Gen (ABB Int) +genABB = do xs <- listOf arbitrary + return (foldr inserta vacio xs) + +-- Los árboles binarios de búsqueda son concreciones de la clase +-- arbitraria. +instance Arbitrary (ABB Int) where + arbitrary = genABB + +-- Propiedad. Todo los elementos generados por genABB son árboles binarios +-- de búsqueda. +prop_genABB_correcto :: ABB Int -> Bool +prop_genABB_correcto = valido + +-- Comprobación. +-- ghci> quickCheck prop_genABB_correcto +-- +++ OK, passed 100 tests. + +-- listaOrdenada es un generador de listas ordenadas de números +-- enteros. Por ejemplo, +-- ghci> sample listaOrdenada +-- [1] +-- [1] +-- [-2,-1,0] +-- [-1,0,1] +-- [-8,-5,-4,-3,3,4,8] +-- [-6,-3,8] +-- [-14,-13] +-- [-31,-23,-16,-13,-11,-5,1,4,11,14,15,21,26,29] +-- [] +-- [] +-- [] +listaOrdenada :: Gen [Int] +listaOrdenada = + frequency [(1,return []), + (4,do xs <- orderedList + n <- arbitrary + return (nub ((case xs of + [] -> n + x:_ -> n `min` x) + :xs)))] + +-- (ordenada xs) se verifica si xs es una lista ordenada creciente. Por +-- ejemplo, +-- ordenada [3,5,9] == True +-- ordenada [3,9,5] == False +ordenada :: [Int] -> Bool +ordenada xs = and [x Property +prop_listaOrdenada_correcta xs = + forAll listaOrdenada ordenada + +-- Comprobación: +-- ghci> quickCheck prop_listaOrdenada_correcta +-- +++ OK, passed 100 tests. + +-- Propiedad. Al eliminar las repeticiones en las listas producidas por el +-- generador orderedList se obtienen listas ordenadas. +prop_orderedList_correcta :: [Int] -> Property +prop_orderedList_correcta xs = + forAll orderedList (ordenada . nub) + +-- Comprobación: +-- ghci> quickCheck prop_orderedList_correcta +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Propiedades -- +-- --------------------------------------------------------------------- + +-- Propiedades de vacio +-- -------------------- + +-- Prop. vacio es un ABB. +prop_vacio_es_ABB :: Bool +prop_vacio_es_ABB = + valido (vacio :: ABB Int) + +-- Comprobación: +-- ghci> quickCheck prop_vacio_es_ABB +-- +++ OK, passed 100 tests. + +-- Propiedades de inserta +-- ---------------------- + +-- Propiedad. Si a es un ABB, entonces (inserta v a) también lo es. +prop_inserta_es_valida :: Int -> ABB Int -> Bool +prop_inserta_es_valida v a = + valido (inserta v a) + +-- Comprobación: +-- ghci> quickCheck prop_inserta_es_valida +-- +++ OK, passed 100 tests. + +-- Propiedad. El árbol que resulta de añadir un elemento a un ABB es no +-- vacío. +prop_inserta_es_no_vacio :: Int -> ABB Int -> Bool +prop_inserta_es_no_vacio x a = + inserta x a /= vacio + +-- Comprobación. +-- ghci> quickCheck prop_inserta_es_no_vacio +-- +++ OK, passed 100 tests. + +-- Propiedad. Para todo x y a, x es un elemento de (inserta x a). +prop_elemento_de_inserta :: Int -> ABB Int -> Bool +prop_elemento_de_inserta x a = + pertenece x (inserta x a) + +-- Comprobación: +-- ghci> quickCheck prop_elemento_de_inserta +-- +++ OK, passed 100 tests. + +-- Propiedades de pertenece +-- ------------------------ + +-- Propiedad. En en árbol vacio no hay ningún elemento. +prop_vacio_sin_elementos :: Int -> Bool +prop_vacio_sin_elementos x = + not (pertenece x vacio) + +-- Comprobación: +-- ghci> quickCheck prop_vacio_sin_elementos +-- +++ OK, passed 100 tests. + +-- Propiedad. Los elementos de (inserta x a) son x y los elementos de +-- a. +prop_elementos_de_inserta :: Int -> Int -> ABB Int -> Bool +prop_elementos_de_inserta x y a = + pertenece y (inserta x a) == (x == y) || pertenece y a + +-- Comprobación. +-- ghci> quickCheck prop_elementos_de_inserta +-- +++ OK, passed 100 tests. + +-- Propiedades de elimina +-- ---------------------- + +-- Propiedad. Si a es un ABB, entonces (elimina v a) también lo es. +prop_elimina_es_valida :: Int -> ABB Int -> Bool +prop_elimina_es_valida v a = + valido (elimina v a) + +-- Comprobación: +-- ghci> quickCheck prop_elimina_es_valida +-- +++ OK, passed 100 tests. + +-- Prop. El resultado de eliminar el elemento x en (inserta x a) es +-- (elimina x a). +prop_elimina_agrega :: Int -> ABB Int -> Bool +prop_elimina_agrega x a = + elimina x (inserta x a) == elimina x a + +-- Comprobación +-- ghci> quickCheck prop_elimina_agrega +-- +++ OK, passed 100 tests. + +-- Propiedades de crea +-- ------------------- + +-- Propiedad. (crea xs) es un ABB. +prop_crea_es_valida :: [Int] -> Bool +prop_crea_es_valida xs = + valido (crea xs) + +-- Comprobación: +-- ghci> quickCheck prop_crea_es_valida +-- +++ OK, passed 100 tests. + +-- Propiedades de crea' +-- -------------------- + +-- Propiedad. Para todas las listas ordenadas xs, se tiene que (crea' xs) +-- es un ABB. +prop_crea'_es_valida :: [Int] -> Property +prop_crea'_es_valida xs = + forAll listaOrdenada (valido . crea') + +-- Comprobación: +-- ghci> quickCheck prop_crea'_es_valida +-- +++ OK, passed 100 tests. + +-- Propiedades de elementos +-- ------------------------ + +-- Propiedad. (elementos (crea xs)) es igual a la lista xs ordenada y +-- sin repeticiones. +prop_elementos_crea :: [Int] -> Bool +prop_elementos_crea xs = + elementos (crea xs) == sort (nub xs) + +-- Comprobación +-- ghci> quickCheck prop_elementos_crea +-- +++ OK, passed 100 tests. + +-- Propiedad. Si ys es una lista ordenada sin repeticiones, entonces +-- (elementos (crea' ys)) es igual ys. +prop_elementos_crea' :: [Int] -> Bool +prop_elementos_crea' xs = + elementos (crea' ys) == ys + where ys = sort (nub xs) + +-- Comprobación +-- ghci> quickCheck prop_elementos_crea' +-- +++ OK, passed 100 tests. + +-- Propiedad. Un elemento pertenece a (elementos a) syss es un valor de a. +prop_en_elementos :: Int -> ABB Int -> Bool +prop_en_elementos v a = + pertenece v a == elem v (elementos a) + +-- Comprobación: +-- ghci> quickCheck prop_enElementos'' +-- +++ OK, passed 100 tests. + +-- Propiedades de menor +-- -------------------- + +-- Propiedad. (menor a) es menor o igual que todos los elementos de ABB +-- a. +prop_menoresMinimo ::Int -> ABB Int -> Bool +prop_menoresMinimo v a = + and [menor a <= v | v <- elementos a] + +-- Comprobación. +-- ghci> quickCheck prop_menoresMinimo +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +abb1, abb2 :: ABB Int +abb1 = crea (reverse [5,2,6,4,8,3,9]) +abb2 = foldr inserta vacio (reverse [5,2,4,3,8,6,7,10,9,11]) + +tests :: TestTree +tests = + testGroup "Propiedades del TAD árboles binarios" + [ testGroup "Ejemplos" + [ testCase "pertenece1" $ pertenece 3 abb1 @?= True + , testCase "pertenece2" $ pertenece 7 abb1 @?= False + , testCase "elementos1" $ elementos abb1 @?= [2,3,4,5,6,8,9] + , testCase "elementos2" $ elementos abb2 @?= [2,3,4,5,6,7,8,9,10,11] + , testCase "menor" $ menor abb1 @?= 2 + , testCase "valido" $ valido abb1 @?= True + ] + , testGroup "Propiedades" + [testProperty "P1" prop_listaOrdenada_correcta, + testProperty "P2" prop_orderedList_correcta, + testProperty "P3" prop_vacio_es_ABB, + testProperty "P4" prop_inserta_es_valida, + testProperty "P5" prop_inserta_es_no_vacio, + testProperty "P6" prop_elemento_de_inserta, + testProperty "P7" prop_vacio_sin_elementos, + testProperty "P8" prop_elementos_de_inserta, + testProperty "P9" prop_elimina_es_valida, + testProperty "P10" prop_elimina_agrega, + testProperty "P11" prop_crea_es_valida, + testProperty "P12" prop_crea'_es_valida, + testProperty "P13" prop_elementos_crea, + testProperty "P14" prop_elementos_crea', + testProperty "P15" prop_en_elementos, + testProperty "P16" prop_menoresMinimo, + testProperty "P17" prop_genABB_correcto]] diff --git a/test/ColaDePrioridadPropiedades.hs b/test/ColaDePrioridadPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/ColaDePrioridadPropiedades.hs @@ -0,0 +1,155 @@ +-- ColaDePrioridadPropiedades.hs +-- Propiedades del TAD de colas de prioridad. +-- José A. Alonso Jiménez +-- --------------------------------------------------------------------- + +module ColaDePrioridadPropiedades (tests) where + +import I1M.ColaDePrioridad +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de colas de prioridad +-- --------------------------------------------------------------------- + +-- genCPrioridad es un generador de colas de prioridad. Por ejemplo, +-- ghci> sample genCPrioridad +-- CP [] +-- CP [] +-- CP [-4] +-- CP [-2,-1,-1,2,5] +-- CP [-8,-5,4,6,8] +-- CP [-4,-1,3,3,6,7,10,10,10,10] +-- CP [-12,-10,-9,-7,2,4,6,7,7,9] +-- CP [-14,-12,-12,-7,-7,-4,4,9,14] +-- CP [-10,-9,-5,14] +-- CP [18] +-- CP [-19,-17,-16,-15,-13,-13,-13,-12,-6,-5,-3,0,2,3,4,5,8,18] +genCPrioridad :: (Arbitrary a, Num a, Ord a) => Gen (CPrioridad a) +genCPrioridad = do xs <- listOf arbitrary + return (foldr inserta vacia xs) + +-- La colas de prioridad son una concreción de la clase arbitraria. +instance (Arbitrary a, Num a, Ord a) => Arbitrary (CPrioridad a) where + arbitrary = genCPrioridad + +-- Prop.: Las colas de prioridad producidas por genCPrioridad son +-- válidas. +prop_genCPrioridad_correcto :: CPrioridad Int -> Bool +prop_genCPrioridad_correcto c = valida c + +-- Comprobación. +-- ghci> quickCheck prop_genCPrioridad_correcto +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Propiedades +-- --------------------------------------------------------------------- + +-- Propiedad. Si se añade dos elementos a una cola de prioridad se +-- obtiene la misma cola de prioridad idependientemente del orden en +-- que se añadan los elementos. +prop_inserta_conmuta :: Int -> Int -> CPrioridad Int -> Bool +prop_inserta_conmuta x y c = + inserta x (inserta y c) == inserta y (inserta x c) + +-- Comprobación. +-- ghci> quickCheck prop_inserta_conmuta +-- +++ OK, passed 100 tests. + +-- Propiedad. La cabeza de la cola de prioridad obtenida anadiendo un +-- elemento x a la cola de prioridad vacía es x. +prop_primero_inserta_vacia :: Int -> CPrioridad Int -> Bool +prop_primero_inserta_vacia x c = + primero (inserta x vacia) == x + +-- Comprobación. +-- ghci> quickCheck prop_primero_inserta_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. El primer elemento de una cola de prioridad c no cambia +-- cuando se le añade un elemento mayor o igual que algún elemento de c. +prop_primero_inserta :: Int -> Int -> CPrioridad Int -> Property +prop_primero_inserta x y c = + x <= y ==> + primero (inserta y c') == primero c' + where c' = inserta x c + +-- Comprobación. +-- ghci> quickCheck prop_primero_inserta +-- +++ OK, passed 100 tests. + +-- Propiedad. El resto de añadir un elemento a la cola de prioridad +-- vacía es la cola vacía. +prop_resto_inserta_vacia :: Int -> Bool +prop_resto_inserta_vacia x = + resto (inserta x vacia) == vacia + +-- Comprobación. +-- ghci> quickCheck prop_resto_inserta_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. El resto de la cola de prioridad obtenida añadiendo un +-- elemento y a una cola c' (que tiene algún elemento menor o igual que +-- y) es la cola que se obtiene añadiendo y al resto de c'. +prop_resto_inserta :: Int -> Int -> CPrioridad Int -> Property +prop_resto_inserta x y c = + x <= y ==> + resto (inserta y c') == inserta y (resto c') + where c' = inserta x c + +-- Comprobación: +-- ghci> quickCheck prop_resto_inserta +-- +++ OK, passed 100 tests. + +-- Propiedad. vacia es una cola vacía. +prop_vacia_es_vacia :: Bool +prop_vacia_es_vacia = esVacia (vacia :: CPrioridad Int) + +-- Comprobación. +-- ghci> quickCheck prop_vacia_es_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. Si se añade un elemento a una cola de prioridad se obtiene +-- una cola no vacía. +prop_inserta_no_es_vacia :: Int -> CPrioridad Int -> Bool +prop_inserta_no_es_vacia x c = + not (esVacia (inserta x c)) + +-- Comprobación. +-- ghci> quickCheck prop_inserta_no_es_vacia +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = + testGroup "Propiedades del TAD de colas de prioridad" + [ testGroup "Ejemplos" + [ testCase "primero" $ + primero (foldr inserta vacia [3,1,7,2,9]) + @?= 1 + , testCase "resto" $ + resto (foldr inserta vacia [3,1,7,2,9]) + @?= foldr inserta vacia [3,7,2,9] + , testCase "esVacia1" $ + esVacia (foldr inserta vacia [3,1,7,2,9]) + @?= False + , testCase "esVacia2" $ + esVacia (vacia :: CPrioridad Int) + @?= True + ] + , testGroup "Propiedades" + [testProperty "P1" prop_inserta_conmuta, + testProperty "P2" prop_primero_inserta_vacia, + testProperty "P3" prop_primero_inserta, + testProperty "P4" prop_resto_inserta_vacia, + testProperty "P5" prop_resto_inserta, + testProperty "P6" prop_vacia_es_vacia, + testProperty "P7" prop_inserta_no_es_vacia + ]] + diff --git a/test/ColaPropiedades.hs b/test/ColaPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/ColaPropiedades.hs @@ -0,0 +1,178 @@ +-- propiedadesColas.hs +-- Propiedades del TAD colas. +-- José A. Alonso Jiménez +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module ColaPropiedades (tests) where + +import I1M.Cola +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de colas -- +-- --------------------------------------------------------------------- + +-- genCola es un generador de colas de enteros. Por ejemplo, +-- ghci> sample genCola +-- C ([],[]) +-- C ([],[]) +-- C ([],[]) +-- C ([],[]) +-- C ([7,8,4,3,7],[5,3,3]) +-- C ([],[]) +-- C ([1],[13]) +-- C ([18,28],[12,21,28,28,3,18,14]) +-- C ([47],[64,45,7]) +-- C ([8],[]) +-- C ([42,112,178,175,107],[]) +genCola :: Gen (Cola Int) +genCola = frequency [(1, return vacia), + (30, do n <- choose (10,100) + xs <- vectorOf n arbitrary + return (creaCola xs))] + where creaCola = foldr inserta vacia + +-- El tipo pila es una instancia del arbitrario. +instance Arbitrary (Cola Int) where + arbitrary = genCola + +-- Propiedad. Todo los elementos generados por genCola son colas +-- válidas. +prop_genCola_correcto :: Cola Int -> Bool +prop_genCola_correcto c = valida c + +-- Comprobación. +-- ghci> quickCheck prop_genCola_correcto +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Propiedades +-- --------------------------------------------------------------------- + +-- Propiedad. El primero de la cola obtenida añadiendo x a la cola vacía +-- es x. +prop_primero_inserta_vacia :: Int -> Bool +prop_primero_inserta_vacia x = + primero (inserta x vacia) == x + +-- Comprobación. +-- > quickCheck prop_primero_inserta_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. Si una cola no está vacía, su primer elemento no varía al +-- añadirle un elemento. +prop_primero_inserta_no_vacia :: Cola Int -> Int -> Int -> Bool +prop_primero_inserta_no_vacia c x y = + primero (inserta x c') == primero c' + where c' = inserta y vacia + +-- Comprobación. +-- > quickCheck prop_primero_inserta_no_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. El resto de la cola obtenida insertando un elemento en la +-- cola vacía es la cola vacía. +prop_resto_inserta_vacia :: Int -> Bool +prop_resto_inserta_vacia x = + resto (inserta x vacia) == vacia + +-- Comprobación. +-- > quickCheck prop_resto_inserta_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. Las operaciones de inserta y resto conmutan. +prop_resto_inserta_en_no_vacia :: Cola Int -> Int -> Int -> Bool +prop_resto_inserta_en_no_vacia c x y = + resto (inserta x c') == inserta x (resto c') + where c' = inserta y c + +-- Comprobación. +-- > quickCheck prop_resto_inserta_en_no_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. vacia es una cola vacía. +prop_vacia_es_vacia :: Bool +prop_vacia_es_vacia = + esVacia vacia + +-- Comprobación. +-- > quickCheck prop_vacia_es_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. La cola obtenida insertando un elemento no es vacía. +prop_inserta_no_es_vacia :: Int -> Cola Int -> Bool +prop_inserta_no_es_vacia x c = + not (esVacia (inserta x c)) + +-- Comprobación +-- > quickCheck prop_inserta_no_es_vacia +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Propiedades de la normalización -- +-- --------------------------------------------------------------------- + +-- Propiedad. La cola vacía es válida. +prop_valida_vacia :: Bool +prop_valida_vacia = valida vacia + +-- Comprobación +-- ghci> quickCheck prop_valida_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. Al añadirle un elemento a una cola válida se obtiene otra +-- cola válida. +prop_valida_inserta :: Cola Int -> Int -> Property +prop_valida_inserta c x = + valida c ==> valida (inserta x c) + +-- Comprobación. +-- ghci> quickCheck prop_valida_inserta +-- +++ OK, passed 100 tests. + +-- Propiedad. El resto de una cola válida y no vacía es una cola válida. +prop_valida_resto :: Cola Int -> Property +prop_valida_resto c = + valida c && not (esVacia c) ==> valida (resto c) + +-- Comprobación +-- *Main> quickCheck prop_valida_resto +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = + testGroup "Propiedades del TAD colas" + [ testGroup "Ejemplos" + [ testCase "primero" $ + primero (foldr inserta vacia [1..10]) + @?= 10 + , testCase "resto" $ + resto (foldr inserta vacia [1..10]) + @?= foldr inserta vacia [1..9] + , testCase "esVacia1" $ + esVacia (foldr inserta vacia [1..10]) + @?= False + , testCase "esVacia1" $ + esVacia vacia + @?= True + ] + , testGroup "Propiedades" + [testProperty "P1" prop_genCola_correcto, + testProperty "P2" prop_primero_inserta_vacia, + testProperty "P3" prop_primero_inserta_no_vacia, + testProperty "P4" prop_resto_inserta_vacia, + testProperty "P5" prop_resto_inserta_en_no_vacia, + testProperty "P6" prop_vacia_es_vacia, + testProperty "P7" prop_inserta_no_es_vacia, + testProperty "P8" prop_valida_vacia, + testProperty "P9" prop_valida_inserta, + testProperty "P10" prop_valida_resto + ]] diff --git a/test/ConjuntoPropiedades.hs b/test/ConjuntoPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/ConjuntoPropiedades.hs @@ -0,0 +1,167 @@ +-- ConjuntoPropiedades.hs +-- Propiedades del TAD conjuntos. +-- José A. Alonso Jiménez +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module ConjuntoPropiedades (tests) where + +import I1M.Conjunto +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de conjuntos -- +-- --------------------------------------------------------------------- + +-- genConjunto es un generador de conjuntos. Por ejemplo, +-- ghci> sample genConjunto +-- {} +-- {} +-- {} +-- {3,-2,-2,-3,-2,4} +-- {-8,0,4,6,-5,-2} +-- {12,-2,-1,-10,-2,2,15,15} +-- {2} +-- {} +-- {-42,55,55,-11,23,23,-11,27,-17,-48,16,-15,-7,5,41,43} +-- {-124,-66,-5,-47,58,-88,-32,-125} +-- {49,-38,-231,-117,-32,-3,45,227,-41,54,169,-160,19} +genConjunto :: Gen (Conj Int) +genConjunto = do xs <- listOf arbitrary + return (foldr inserta vacio xs) + +-- Los conjuntos son concreciones de los arbitrarios. +instance Arbitrary (Conj Int) where + arbitrary = genConjunto + +-- --------------------------------------------------------------------- +-- Propiedades -- +-- --------------------------------------------------------------------- + +-- Propiedades de inserta +-- ---------------------- + +-- Propiedad. El número de veces que se añada un elemento a un conjunto +-- no importa. +prop_independencia_repeticiones :: Int -> Conj Int -> Bool +prop_independencia_repeticiones x c = + inserta x (inserta x c) == inserta x c + +-- Comprobación. +-- ghci> quickCheck prop_independencia_repeticiones +-- +++ OK, passed 100 tests. + +-- Propiedad. El orden en que se añadan los elementos a un conjunto no +-- importa. +prop_independencia_del_orden :: Int -> Int -> Conj Int -> Bool +prop_independencia_del_orden x y c = + inserta x (inserta y c) == inserta y (inserta x c) + +-- Comprobación. +-- ghci> quickCheck prop_independencia_del_orden +-- +++ OK, passed 100 tests. + +-- Propiedades de pertenece +-- ------------------------ + +-- Propiedad. El conjunto vacío no tiene elementos. +prop_vacio_no_elementos:: Int -> Bool +prop_vacio_no_elementos x = + not (pertenece x vacio) + +-- Comprobación. +-- ghci> quickCheck prop_vacio_no_elementos +-- +++ OK, passed 100 tests. + +-- Propiedad. Un elemento pertenece al conjunto obtenido añadiendo x al +-- conjunto c syss es igual a x o pertenece a c. +prop_pertenece_inserta :: Int -> Int -> Conj Int -> Bool +prop_pertenece_inserta x y c = + pertenece y (inserta x c) == (x==y) || pertenece y c + +-- Comprobación. +-- ghci> quickCheck prop_pertenece_inserta +-- +++ OK, passed 100 tests. + +-- Propiedades de elimina +-- ---------------------- + +-- Propiedad. Al eliminar cualquier elemento del conjunto vacío se +-- obtiene el conjunto vacío. +prop_elimina_vacio :: Int -> Bool +prop_elimina_vacio x = + elimina x vacio == vacio + +-- Comprobación. +-- ghci> quickCheck prop_elimina_vacio +-- +++ OK, passed 100 tests. + +-- Propiedad. El resultado de eliminar x en el conjunto obtenido +-- añadiéndole x al conjunto c es c menos x, si x e y son iguales y es el +-- conjunto obtenido añadiéndole y a c menos x, en caso contrario. +prop_elimina_inserta :: Int -> Int -> Conj Int -> Bool +prop_elimina_inserta x y c = + elimina x (inserta y c) + == if x == y + then elimina x c + else inserta y (elimina x c) + +-- Comprobación +-- ghci> quickCheck prop_elimina_inserta +-- +++ OK, passed 100 tests. + +-- Propiedades de esVacio +-- ---------------------- + +-- Propiedad. vacio es vacío. +prop_vacio_es_vacio :: Bool +prop_vacio_es_vacio = + esVacio (vacio :: Conj Int) + +-- Comprobación. +-- ghci> quickCheck prop_vacio_esvacio +-- +++ OK, passed 100 tests. + +-- Propiedad. Los conjuntos construidos con inserta no son vacío. +prop_inserta_es_no_vacio :: Int -> Conj Int -> Bool +prop_inserta_es_no_vacio x c = + not (esVacio (inserta x c)) + +-- Comprobación +-- ghci> quickCheck prop_inserta_es_no_vacio +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +c1, c2, c3 :: Conj Int +c1 = foldr inserta vacio [2,5,3,2] +c2 = foldr inserta vacio [2,3,4,5] +c3 = foldr inserta vacio [2,5] + +tests :: TestTree +tests = + testGroup "Propiedades del TAD de conjuntos" + [ testGroup "Ejemplos" + [ testCase "esVacio1" $ esVacio c1 @?= False + , testCase "esVacio2" $ esVacio vacio @?= True + , testCase "pertenece1" $ pertenece 3 c1 @?= True + , testCase "pertenece2" $ pertenece 3 c1 @?= True + , testCase "inserta1" $ inserta 3 c1 @?= c1 + , testCase "inserta2" $ inserta 4 c1 @?= c2 + , testCase "elimina1" $ elimina 3 c1 @?= c3 + , testCase "elimina2" $ elimina 4 c1 @?= c1 + ] + , testGroup "Propiedades" + [testProperty "P1" prop_vacio_es_vacio, + testProperty "P2" prop_inserta_es_no_vacio, + testProperty "P3" prop_independencia_repeticiones, + testProperty "P4" prop_independencia_del_orden, + testProperty "P5" prop_vacio_no_elementos, + testProperty "P6" prop_pertenece_inserta, + testProperty "P7" prop_elimina_vacio, + testProperty "P8" prop_elimina_inserta]] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,35 @@ +-- Main.hs +-- Propiedades de los TAD, +-- José A. Alonso Jiménez y +-- Sevilla, 15 de Noviembre de 2010 +-- --------------------------------------------------------------------- + +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +import qualified PilaPropiedades (tests) +import qualified ColaPropiedades (tests) +import qualified ColaDePrioridadPropiedades (tests) +import qualified ConjuntoPropiedades (tests) +import qualified TablaPropiedades (tests) +import qualified ArbolBinPropiedades (tests) +import qualified MonticuloPropiedades (tests) +import qualified PolPropiedades (tests) +import qualified PolOperacionesPropiedades (tests) + +main :: IO () +main = defaultMain tests + +tests = + testGroup "Comprobaciones" + [ PilaPropiedades.tests + , ColaPropiedades.tests + , ColaDePrioridadPropiedades.tests + , ConjuntoPropiedades.tests + , TablaPropiedades.tests + , ArbolBinPropiedades.tests + , MonticuloPropiedades.tests + , PolPropiedades.tests + , PolOperacionesPropiedades.tests + ] diff --git a/test/MonticuloPropiedades.hs b/test/MonticuloPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/MonticuloPropiedades.hs @@ -0,0 +1,172 @@ +-- MonticuloPropiedades.hs +-- Propiedades del TAD montículos. +-- José A. Alonso Jiménez +-- Sevilla, 30 de Diciembre de 2010 +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module MonticuloPropiedades (tests) where + +import I1M.Monticulo +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de montículos -- +-- --------------------------------------------------------------------- + +-- (creaMonticulo xs) es el montículo correspondiente a la lista xs. Por +-- ejemplo, +-- ghci> creaMonticulo [6,1,4,8] +-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio) +creaMonticulo :: [Int] -> Monticulo Int +creaMonticulo = foldr inserta vacio + +-- genMonticulo es un generador de montículos. Por ejemplo, +-- ghci> sample genMonticulo +-- VacioM +-- M (-1) 1 (M 1 1 VacioM VacioM) VacioM +-- ... +genMonticulo :: Gen (Monticulo Int) +genMonticulo = do xs <- listOf arbitrary + return (creaMonticulo xs) + +-- Montículo es una instancia de la clase arbitraria. +instance Arbitrary (Monticulo Int) where + arbitrary = genMonticulo + +-- genMonticulo genera montículos válidos. +prop_genMonticulo :: Monticulo Int -> Bool +prop_genMonticulo m = valido m + +-- Comprobación. +-- ghci> quickCheck prop_genMonticulo +-- +++ OK, passed 100 tests. + +-- monticuloNV es un generador de montículos no vacío. Por ejemplo, +-- ghci> sample monticuloNV +-- M 0 1 VacioM VacioM +-- M 1 1 (M 1 1 (M 1 1 VacioM VacioM) VacioM) VacioM +-- M 0 2 (M 1 1 VacioM VacioM) (M 2 1 VacioM VacioM) +-- M (-4) 2 (M (-3) 1 VacioM VacioM) (M 1 1 VacioM VacioM) +-- M 3 1 VacioM VacioM +-- M (-8) 1 (M (-5) 1 VacioM VacioM) VacioM +monticuloNV :: Gen (Monticulo Int) +monticuloNV = do xs <- listOf arbitrary + x <- arbitrary + return (creaMonticulo (x:xs)) + +-- Prop. monticuloNV genera montículos no vacío. +prop_monticuloNV :: Monticulo Int -> Property +prop_monticuloNV m = + forAll monticuloNV (\m -> (valido m) && not (esVacio m)) + +-- Comprobación. +-- *Main> quickCheck prop_monticuloNV +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Propiedades +-- --------------------------------------------------------------------- + +-- Propiedades de vacio +-- -------------------- + +-- Propiedad. vacio es un montículo. +prop_vacio_es_monticulo :: Bool +prop_vacio_es_monticulo = + esVacio (vacio :: Monticulo Int) + +-- Comprobación. +-- ghci> prop_vacio_es_monticulo +-- True + +-- Propiedades de inserta +-- ---------------------- + +-- Propiedad. inserta produce montículos válidos. +prop_inserta_es_valida :: Int -> Monticulo Int -> Bool +prop_inserta_es_valida x m = + valido (inserta x m) + +-- Comprobación. +-- ghci> quickCheck prop_inserta_es_valida +-- +++ OK, passed 100 tests. + +-- Propiedad. Los montículos creados con inserta son no vacío. +prop_inserta_no_vacio :: Int -> Monticulo Int -> Bool +prop_inserta_no_vacio x m = + not (esVacio (inserta x m)) + +-- Comprobación. +-- ghci> quickCheck prop_inserta_no_vacio +-- +++ OK, passed 100 tests. + +-- Propiedades de resto +-- -------------------- + +-- Propiedad. Al borrar el menor elemento de un montículo no vacío se +-- obtiene un montículo válido. +prop_resto_es_valida :: Monticulo Int -> Property +prop_resto_es_valida m = + forAll monticuloNV (\m -> valido (resto m)) + +-- Comprobación. +-- ghci> quickCheck prop_resto_es_valida +-- +++ OK, passed 100 tests. + +-- Propiedad. El resto de (inserta x m) es m si m es el montículo vacío +-- o x es menor o igual que el menor elemento de m o (inserta x (resto m)), +-- en caso contrario. +prop_resto_inserta :: Int -> Monticulo Int -> Bool +prop_resto_inserta x m = + resto (inserta x m) + == if esVacio m || x <= menor m + then m + else inserta x (resto m) + +-- Comprobación. +-- ghci> quickCheck prop_resto_inserta +-- +++ OK, passed 100 tests. + +-- Propiedades de menor +-- -------------------- + +-- Propiedad. (menor m) es el menor elemento del montículo m. +prop_menor_es_minimo :: Monticulo Int -> Bool +prop_menor_es_minimo m = + esVacio m || + esVacio (resto m) || + menor m <= menor (resto m) + +-- Comprobación. +-- ghci> quickCheck prop_menor_es_minimo +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = + testGroup "Propiedades del TAD monticulo" + [ testGroup "Ejemplos" + [ testCase "menor1" $ + menor (foldr inserta vacio [6,1,4,8]) @?= 1 + , testCase "menor2" $ + menor (foldr inserta vacio [7,5]) @?= 5 + , testCase "igualdad" $ + (foldr inserta vacio [6,1,4]) == (foldr inserta vacio [6,4,1]) + @?= True + ] + , testGroup "Propiedades" + [testProperty "P1" prop_genMonticulo, + testProperty "P2" prop_monticuloNV, + testProperty "P3" prop_vacio_es_monticulo, + testProperty "P4" prop_inserta_es_valida, + testProperty "P5" prop_inserta_no_vacio, + testProperty "P6" prop_resto_es_valida, + testProperty "P7" prop_resto_inserta, + testProperty "P8" prop_menor_es_minimo]] diff --git a/test/PilaPropiedades.hs b/test/PilaPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/PilaPropiedades.hs @@ -0,0 +1,107 @@ +-- PilaPropiedades.hs +-- Propiedades del TAD pilas. +-- José A. Alonso Jiménez y +-- María J. Hidalgo Doblado +-- Sevilla, 15 de Noviembre de 2010 +-- --------------------------------------------------------------------- + +module PilaPropiedades (tests) where + +import I1M.Pila +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de pilas -- +-- --------------------------------------------------------------------- + +-- genPila es un generador de pilas. Por ejemplo, +-- ghci> sample genPila +-- - +-- 0|0|- +-- - +-- -6|4|-3|3|0|- +-- - +-- 9|5|-1|-3|0|-8|-5|-7|2|- +-- -3|-10|-3|-12|11|6|1|-2|0|-12|-6|- +-- 2|-14|-5|2|- +-- 5|9|- +-- -1|-14|5|- +-- 6|13|0|17|-12|-7|-8|-19|-14|-5|10|14|3|-18|2|-14|-11|-6|- +genPila :: (Arbitrary a, Num a) => Gen (Pila a) +genPila = do xs <- listOf arbitrary + return (foldr apila vacia xs) + +-- El tipo pila es una instancia del arbitrario. +instance (Arbitrary a, Num a) => Arbitrary (Pila a) where + arbitrary = genPila + +-- --------------------------------------------------------------------- +-- Propiedades +-- --------------------------------------------------------------------- + +-- Propiedad. La cima de la pila que resulta de apilar x en una pila p +-- es x. +prop_cima_apila :: Int -> Pila Int -> Bool +prop_cima_apila x p = + cima (apila x p) == x + +-- Comprobación. +-- > quickCheck prop_cima_apila +-- +++ OK, passed 100 tests. + +-- Propiedad. La pila que resulta de desapilar después de apilar +-- cualquier elemento es la pila inicial. +prop_desapila_apila :: Int -> Pila Int -> Bool +prop_desapila_apila x p = + desapila (apila x p) == p + +-- Comprobación. +-- > quickCheck prop_desapila_apila +-- +++ OK, passed 100 tests. + +-- Propiedad. La pila vacía está vacía. +prop_vacia_esta_vacia :: Bool +prop_vacia_esta_vacia = esVacia vacia + +-- Comprobación. +-- > quickCheck prop_vacia_esta_vacia +-- +++ OK, passed 100 tests. + +-- Propiedad. La pila que resulta de apilar un elemento en un pila +-- cualquiera no es vacía. +prop_apila_no_es_vacia :: Int -> Pila Int -> Bool +prop_apila_no_es_vacia x p = not (esVacia (apila x p)) + +-- Comprobación. +-- > quickCheck prop_apila_no_es_vacia +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = + testGroup "Propiedades del TAD pilas" + [ testGroup "ejemplos" + [ testCase "cima1" $ + cima (apila 1 (apila 2 (apila 3 vacia))) + @?= 1 + , testCase "desapila1" $ + desapila (apila 1 (apila 2 (apila 3 vacia))) + @?= apila 2 (apila 3 vacia) + , testCase "esVacia1" $ + esVacia (apila 1 (apila 2 (apila 3 vacia))) + @?= False + , testCase "esVacia2" $ + esVacia vacia + @?= True + ] + , testGroup "propiedades" + [testProperty "P1" prop_cima_apila, + testProperty "P2" prop_desapila_apila, + testProperty "P3" prop_vacia_esta_vacia, + testProperty "P4" prop_apila_no_es_vacia]] + diff --git a/test/PolOperacionesPropiedades.hs b/test/PolOperacionesPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/PolOperacionesPropiedades.hs @@ -0,0 +1,147 @@ +-- | +-- Module : PolOperacionesPropiedades +-- Description : Propiedades de las Operaciones con el TAD de los polinomios. +-- License : Creative Commons +-- Maintainer : José A. Alonso + +{-# LANGUAGE FlexibleInstances #-} + +module PolOperacionesPropiedades (tests) where + +import I1M.PolOperaciones +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de polinomios -- +-- --------------------------------------------------------------------- + +-- (genPol n) es un generador de polinomios. Por ejemplo, +-- ghci> sample (genPol 1) +-- 7*x^9 + 9*x^8 + 10*x^7 + -14*x^5 + -15*x^2 + -10 +-- -4*x^8 + 2*x +-- -8*x^9 + 4*x^8 + 2*x^6 + 4*x^5 + -6*x^4 + 5*x^2 + -8*x +-- -9*x^9 + x^5 + -7 +-- 8*x^10 + -9*x^7 + 7*x^6 + 9*x^5 + 10*x^3 + -1*x^2 +-- 7*x^10 + 5*x^9 + -5 +-- -8*x^10 + -7 +-- -5*x +-- 5*x^10 + 4*x^4 + -3 +-- 3*x^3 + -4 +-- 10*x +genPol :: Int -> Gen (Polinomio Int) +genPol 0 = return polCero +genPol n = do n <- choose (0,10) + b <- choose (-10,10) + p <- genPol (div n 2) + return (consPol n b p) + +instance Arbitrary (Polinomio Int) where + arbitrary = sized genPol + +-- --------------------------------------------------------------------- +-- Propiedades -- +-- --------------------------------------------------------------------- + +-- --------------------------------------------------------------------- +-- Suma de polinomios -- +-- --------------------------------------------------------------------- + +-- Propiedad. El polinomio cero es el elemento neutro de la suma. +prop_neutroSumaPol :: Polinomio Int -> Bool +prop_neutroSumaPol p = + sumaPol polCero p == p + +-- Comprobación con QuickCheck. +-- ghci> quickCheck prop_neutroSumaPol +-- OK, passed 100 tests. + +-- Propiedad. La suma es conmutativa. +prop_conmutativaSuma :: Polinomio Int -> Polinomio Int -> Bool +prop_conmutativaSuma p q = + sumaPol p q == sumaPol q p + +-- Comprobación: +-- ghci> quickCheck prop_conmutativaSuma +-- OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Producto de polinomios -- +-- --------------------------------------------------------------------- + +-- Propiedad. El producto de polinomios es conmutativo. +prop_conmutativaProducto :: Polinomio Int -> Polinomio Int -> Bool +prop_conmutativaProducto p q = + multPol p q == multPol q p + +-- La comprobación es +-- ghci> quickCheck prop_conmutativaProducto +-- OK, passed 100 tests. + +-- El producto es distributivo respecto de la suma. +prop_distributivaProductoSuma :: Polinomio Int -> Polinomio Int + -> Polinomio Int -> Bool +prop_distributivaProductoSuma p q r = + multPol p (sumaPol q r) == sumaPol (multPol p q) (multPol p r) + +-- Comprobación: +-- ghci> quickCheck prop_distributivaProductoSuma +-- OK, passed 100 tests. + +-- Propiedad. El polinomio unidad es el elemento neutro del producto. +prop_polUnidad :: Polinomio Int -> Bool +prop_polUnidad p = + multPol p polUnidad == p + +-- Comprobación: +-- ghci> quickCheck prop_polUnidad +-- OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Derivación de polinomios -- +-- --------------------------------------------------------------------- + +-- Propiedad. La derivada de la suma es la suma de las derivadas. +prop_derivada :: Polinomio Int -> Polinomio Int -> Bool +prop_derivada p q = + derivada (sumaPol p q) == sumaPol (derivada p) (derivada q) + +-- Comprobación +-- ghci> quickCheck prop_derivada +-- OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +ejPol1, ejPol2, ejPol3, ejTerm:: Polinomio Int +ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +ejPol3 = consPol 4 6 (consPol 1 2 polCero) +ejTerm = consPol 1 4 polCero + +tests :: TestTree +tests = + testGroup "Propiedades de las operaciones con polinomios" + [ testGroup "Ejemplos" + [ testCase "termLider" $ + termLider ejPol2 @?= creaTermino 5 1 + , testCase "valor1" $ + valor ejPol1 0 @?= 3 + , testCase "valor2" $ + valor ejPol1 1 @?= 1 + , testCase "valor3" $ + valor ejPol1 (-2) @?= 31 + , testCase "esRaiz1" $ + esRaiz 1 ejPol3 @?= False + , testCase "esRaiz2" $ + esRaiz 0 ejPol3 @?= True + ] + , testGroup "Propiedades" + [testProperty "P1" prop_neutroSumaPol, + testProperty "P2" prop_conmutativaSuma, + testProperty "P3" prop_conmutativaProducto, + testProperty "P4" prop_distributivaProductoSuma, + testProperty "P5" prop_polUnidad, + testProperty "P6" prop_derivada]] diff --git a/test/PolPropiedades.hs b/test/PolPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/PolPropiedades.hs @@ -0,0 +1,138 @@ +-- PolPropiedades.hs +-- Propiedades del TAD de los polinomios. +-- José A. Alonso Jiménez +-- Sevilla, 8 de Enero de 2011 +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module PolPropiedades (tests) where + +import I1M.Pol +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generador de polinomios -- +-- --------------------------------------------------------------------- + +-- (genPol n) es un generador de polinomios. Por ejemplo, +-- ghci> sample (genPol 1) +-- 7*x^9 + 9*x^8 + 10*x^7 + -14*x^5 + -15*x^2 + -10 +-- -4*x^8 + 2*x +-- -8*x^9 + 4*x^8 + 2*x^6 + 4*x^5 + -6*x^4 + 5*x^2 + -8*x +-- -9*x^9 + x^5 + -7 +-- 8*x^10 + -9*x^7 + 7*x^6 + 9*x^5 + 10*x^3 + -1*x^2 +-- 7*x^10 + 5*x^9 + -5 +-- -8*x^10 + -7 +-- -5*x +-- 5*x^10 + 4*x^4 + -3 +-- 3*x^3 + -4 +-- 10*x +genPol :: Int -> Gen (Polinomio Int) +genPol 0 = return polCero +genPol n = do n <- choose (0,10) + b <- choose (-10,10) + p <- genPol (div n 2) + return (consPol n b p) + +instance Arbitrary (Polinomio Int) where + arbitrary = sized genPol + +-- --------------------------------------------------------------------- +-- Propiedades -- +-- --------------------------------------------------------------------- + +-- Propiedad. polCero es el polinomio cero. +prop_polCero_es_cero :: Bool +prop_polCero_es_cero = + esPolCero polCero + +-- Comprobación. +-- ghci> quickCheck prop_polCero_es_cero +-- +++ OK, passed 100 tests. + +-- Propiedad. Si n es mayor que el grado de p y b no es cero, entonces +-- (consPol n b p) es un polinomio distinto del cero. +prop_consPol_no_cero :: Int -> Int -> Polinomio Int -> Property +prop_consPol_no_cero n b p = + n > grado p && b /= 0 ==> + not (esPolCero (consPol n b p)) + +-- Comprobación. +-- ghci> quickCheck prop_consPol_no_cero +-- +++ OK, passed 100 tests. + +-- Propiedad. (consPol (grado p) (coefLider p) (restoPol p)) es igual a p. +prop_consPol :: Polinomio Int -> Bool +prop_consPol p = + consPol (grado p) (coefLider p) (restoPol p) == p + +-- Comprobación +-- > quickCheck prop_consPol +-- +++ OK, passed 100 tests. + +-- Propiedad. Si n es mayor que el grado de p y b no es cero, entonces +-- el grado de (consPol n b p) es n. +prop_grado :: Int -> Int -> Polinomio Int -> Property +prop_grado n b p = + n > grado p && b /= 0 ==> + grado (consPol n b p) == n + +-- Comprobación. +-- ghci> quickCheck prop_grado +-- +++ OK, passed 100 tests. + +-- Propiedad. Si n es mayor que el grado de p y b no es cero, entonces +-- el coeficiente líder de (consPol n b p) es b. +prop_coefLider :: Int -> Int -> Polinomio Int -> Property +prop_coefLider n b p = + n > grado p && b /= 0 ==> + coefLider (consPol n b p) == b + +-- Comprobación. +-- ghci> quickCheck prop_coefLider +-- +++ OK, passed 100 tests. + +-- Propiedad. Si n es mayor que el grado de p y b no es cero, entonces +-- el resto de (consPol n b p) es p. +prop_restoPol :: Int -> Int -> Polinomio Int -> Property +prop_restoPol n b p = + n > grado p && b /= 0 ==> + restoPol (consPol n b p) == p + +-- Comprobación. +-- ghci> quickCheck prop_restoPol +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +ejPol1, ejPol2, ejPol3:: Polinomio Int +ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +ejPol3 = consPol 4 6 (consPol 1 2 polCero) + +ejPol5, ejPol6, ejPol7:: Polinomio Float +ejPol5 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero)) +ejPol6 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero)) +ejPol7 = consPol 1 2 (consPol 4 6 polCero) + +tests :: TestTree +tests = + testGroup "Propiedades del TAD polinomio" + [ testGroup "Ejemplos" + [ testCase "EsPolCero1" $ esPolCero polCero @?= True + , testCase "EsPolCero1" $ esPolCero ejPol1 @?= False + , testCase "grado" $ grado ejPol3 @?= 4 + , testCase "coefLider" $ coefLider ejPol3 @?= 6 + ] + , testGroup "Propiedades" + [testProperty "P1" prop_polCero_es_cero, + testProperty "P2" prop_consPol_no_cero, + testProperty "P3" prop_consPol, + testProperty "P4" prop_grado, + testProperty "P5" prop_coefLider, + testProperty "P6" prop_restoPol]] diff --git a/test/TablaPropiedades.hs b/test/TablaPropiedades.hs new file mode 100644 --- /dev/null +++ b/test/TablaPropiedades.hs @@ -0,0 +1,121 @@ +-- TablaPropiedades.hs +-- Propiedades del TAD tablas. +-- José A. Alonso Jiménez +-- Sevilla, 29 de Diciembre de 2010 +-- --------------------------------------------------------------------- + +{-# LANGUAGE FlexibleInstances #-} + +module TablaPropiedades (tests) where + +import I1M.Tabla +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit + +-- --------------------------------------------------------------------- +-- Generadores de tablas -- +-- --------------------------------------------------------------------- + +-- genTabla es un generador de tablas. Por ejemplo, +-- ghci> sample genTabla +-- Tbl [(1,0)] +-- Tbl [(1,-1)] +-- Tbl [(1,0),(2,-1),(3,1),(4,1),(5,0)] +-- Tbl [(1,1),(2,-1),(3,-1),(4,3)] +-- Tbl [(1,3),(2,-5),(3,-7),(4,-2),(5,-8)] +-- Tbl [(1,16),(2,-6),(3,-13),(4,-7),(5,2),(6,11)] +-- Tbl [(1,-4),(2,-1),(3,3),(4,5)] +-- Tbl [(1,-8),(2,16),(3,32)] +genTabla :: Gen (Tabla Int Int) +genTabla = + do x <- arbitrary + xs <- listOf arbitrary + return (tabla (zip [1..] (x:xs))) + +-- Las tablas son concreciones de los arbitrarios. +instance Arbitrary (Tabla Int Int) where + arbitrary = genTabla + +-- --------------------------------------------------------------------- +-- Propiedades -- +-- --------------------------------------------------------------------- + +-- Propiedades de modifica +-- ----------------------- + +-- Propiedad. Al modificar una tabla dos veces con la misma clave se +-- obtiene el mismos resultado que modificarla una vez con el último +-- valor. +prop_modifica_modifica_1 :: Int -> Int -> Int -> Tabla Int Int -> Bool +prop_modifica_modifica_1 i v v' t = + modifica (i,v') (modifica (i,v) t) + == modifica (i,v') t + +-- Comprobación. +-- ghci> quickCheck prop_modifica_modifica_1 +-- +++ OK, passed 100 tests. + +-- Propiedad. Al modificar una tabla con dos pares con claves distintas +-- no importa el orden en que se añadan los pares. +prop_modifica_modifica_2 :: Int -> Int -> Int -> Int -> Tabla Int Int + -> Property +prop_modifica_modifica_2 i i' v v' t = + i /= i' ==> + modifica (i',v') (modifica (i,v) t) + == modifica (i,v) (modifica (i',v') t) + +-- Comprobación. +-- ghci> quickCheck prop_modifica_modifica_2 +-- +++ OK, passed 100 tests. + +-- Propiedades de valor +-- -------------------- + +-- Propiedad. El valor de la clave i en la tabla obtenida añadiéndole el +-- par (i,v) a la tabla t es v. +prop_valor_modifica_1 :: Int -> Int -> Tabla Int Int -> Bool +prop_valor_modifica_1 i v t = + valor (modifica (i,v) t) i == v + +-- Comprobación. +-- ghci> quickCheck prop_valor_modifica_1 +-- +++ OK, passed 100 tests. + +-- Propiedad. Sean i y i' dos claves distintas. El valor de la clave i' +-- en la tabla obtenida añadiéndole el par (i,v) a la tabla t' (que +-- contiene la clave i') es el valor de i' en t'. +prop_valor_modifica_2 :: Int -> Int -> Int -> Int -> Tabla Int Int + -> Property +prop_valor_modifica_2 i v i' v' t = + i /= i' ==> + valor (modifica (i,v) t') i' == valor t' i' + where t' = modifica (i',v') t + +-- Comprobación. +-- ghci> quickCheck prop_valor_modifica_2 +-- +++ OK, passed 100 tests. + +-- --------------------------------------------------------------------- +-- Comprobaciones -- +-- --------------------------------------------------------------------- + +t1 = tabla [(i,f i) | i <- [1..6] ] + where f x | x < 3 = x + | otherwise = 3-x +t2 = tabla [(4,89), (1,90), (2,67)] + +tests :: TestTree +tests = + testGroup "Propiedades del TAD tablas" + [ testGroup "Ejemplos" + [ testCase "valo1" $ valor t1 6 @?= -3 + , testCase "valo2" $ valor t2 2 @?= 67 + , testCase "modifica" $ + valor (modifica (6,9) t1) 6 @?= 9 + ] + , testGroup "Propiedades" + [testProperty "P1" prop_modifica_modifica_1, + testProperty "P2" prop_modifica_modifica_2, + testProperty "P3" prop_valor_modifica_1, + testProperty "P4" prop_valor_modifica_2]]