From ee5ebdb01c4daf860f0b217953bcc0c2b90e292d Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 20 Sep 2023 10:58:33 +0100 Subject: [PATCH 01/26] Added vector module for use with examples --- example/Util/BMA.purs | 0 package-lock.json | 330 +++++++++++++++++++++++++++++++++-- spago.dhall | 1 + yarn.lock | 387 +++++++++++++++++------------------------- 4 files changed, 479 insertions(+), 239 deletions(-) create mode 100644 example/Util/BMA.purs diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs new file mode 100644 index 000000000..e69de29bb diff --git a/package-lock.json b/package-lock.json index 5aea65ac0..2acd7babe 100644 --- a/package-lock.json +++ b/package-lock.json @@ -14,7 +14,6 @@ "d3-tip": "0.9.1", "datetime": "^0.0.3", "js-date": "^0.1.3", - "process": "^0.11.10", "purescript": "^0.15.10" }, "devDependencies": { @@ -85,6 +84,22 @@ "node": ">=0.1.90" } }, + "node_modules/@esbuild/linux-loong64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/@esbuild/linux-loong64/-/linux-loong64-0.15.1.tgz", + "integrity": "sha512-1tORADNFK9QS4KYyUyh3Td9WGrdiI1rSoKvY6A43+9G0kPujBuT4lIGyoK0AweOSO1aRIR28xQUfiJCUa78bUw==", + "cpu": [ + "loong64" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, "node_modules/@gar/promisify": { "version": "1.1.3", "resolved": "https://registry.npmjs.org/@gar/promisify/-/promisify-1.1.3.tgz", @@ -1497,7 +1512,6 @@ "integrity": "sha512-zgxo2st9wSbdiR6rTo44l/L7ohttqdXFmhUi5tE6yWahgdBjCwZjBgIkm/gr/TcBTTIwyzd7em8WI37yZ+F2Mg==", "dev": true, "hasInstallScript": true, - "license": "MIT", "bin": { "esbuild": "bin/esbuild" }, @@ -1528,6 +1542,118 @@ "esbuild-windows-arm64": "0.15.1" } }, + "node_modules/esbuild-android-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-android-64/-/esbuild-android-64-0.15.1.tgz", + "integrity": "sha512-q5kkJZsgLIkyh5e2ZJl4/kXKIueBKtjVMEihP9WCHadqhH6+F9qiycE7fBwUb/g2B15mYlmMBXjp8VmOT3J2gA==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "android" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-android-arm64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-android-arm64/-/esbuild-android-arm64-0.15.1.tgz", + "integrity": "sha512-IQuZOzqMaFceLlKJJA27CXAdh+Mzh2ZblHMmcNIu/wxb6iX1zgYXlPWle62iHnmNCtfAux1mzQvmNsP9aLhemA==", + "cpu": [ + "arm64" + ], + "dev": true, + "optional": true, + "os": [ + "android" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-darwin-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-darwin-64/-/esbuild-darwin-64-0.15.1.tgz", + "integrity": "sha512-tyouWLyxwM/Y2fy/reuIvAvVB+KVQwuY9IVyV7LH5CGkJYxgtLb8xVEiwHFF8TG2uo9a2fqdgWffados4YA6Aw==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-darwin-arm64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-darwin-arm64/-/esbuild-darwin-arm64-0.15.1.tgz", + "integrity": "sha512-fb4V1eB1nir3zJwsS75itsbahkbM71XuqUDJVH8iyBLS8VIQD7MWWAAekea2l9keueGfsn0+wTyDluMT+kg8Cw==", + "cpu": [ + "arm64" + ], + "dev": true, + "optional": true, + "os": [ + "darwin" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-freebsd-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-freebsd-64/-/esbuild-freebsd-64-0.15.1.tgz", + "integrity": "sha512-1KxEv/FUPlQtUSOjFCwR8FVNEskB5LmkbfW9FNJ7lhpG+4RsLiHWw4Sl2Y1/S+aKX7inyWxLA05zYV6XAzO8DA==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "freebsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-freebsd-arm64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-freebsd-arm64/-/esbuild-freebsd-arm64-0.15.1.tgz", + "integrity": "sha512-ueUMGSNrcuHwAadioxBdfOCO4+bTVeI68a147BQ/AFFIrf4XJNow4UXxguvQlZO+ZYaVz6EztaL6mHslKie2Rw==", + "cpu": [ + "arm64" + ], + "dev": true, + "optional": true, + "os": [ + "freebsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-32": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-32/-/esbuild-linux-32-0.15.1.tgz", + "integrity": "sha512-K5WWcN2OZkZ6arFN3+hi1leKc0at9ukKGrXK9Ia94kQOesBphTSmsNK/Gy/AoVoIa0bWrHtxDijS9j9+dz86oA==", + "cpu": [ + "ia32" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, "node_modules/esbuild-linux-64": { "version": "0.15.1", "resolved": "https://registry.npmjs.org/esbuild-linux-64/-/esbuild-linux-64-0.15.1.tgz", @@ -1545,6 +1671,198 @@ "node": ">=12" } }, + "node_modules/esbuild-linux-arm": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-arm/-/esbuild-linux-arm-0.15.1.tgz", + "integrity": "sha512-qjAkEDcFhVNYwG2xgaDg/hA8JABoMvjzAzE6g1K8kR516oNkKbVf6rN68UrsQaV1zq1qR3dbVeMv/Ul2bheppA==", + "cpu": [ + "arm" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-arm64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-arm64/-/esbuild-linux-arm64-0.15.1.tgz", + "integrity": "sha512-TP0BCVZEVu/aoVaZe2sn1vpvo63j0LPiH8rvd7AegqOfTwb+mcxLxpgyYwkibafUCMxnIrKdUTsSJeusoMhcLg==", + "cpu": [ + "arm64" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-mips64le": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-mips64le/-/esbuild-linux-mips64le-0.15.1.tgz", + "integrity": "sha512-8vzQzp+kwrn1Y+OjvfFaLS8uL8aR39WnAtxOHwjB72s9g18kHFlE8IQLS9dWDQgKpBSFq9kazsJE65dSVmz+VA==", + "cpu": [ + "mips64el" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-ppc64le": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-ppc64le/-/esbuild-linux-ppc64le-0.15.1.tgz", + "integrity": "sha512-QlWSOgC2Ad53Xvf7ZivXU7wM2y29YhQUrd50PjK0QJ3psh/eYSQx77PTe1iWm7Ovjiqv1wPKEAyC7CbyJUgriw==", + "cpu": [ + "ppc64" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-riscv64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-riscv64/-/esbuild-linux-riscv64-0.15.1.tgz", + "integrity": "sha512-/PRNgNsiwb7G2n3rB5WcHinCwKj0OqUmtu8cdakV4CLNWnFnfChEGEJX1x5n8RcGD3xPUlI5CgqFe0/oBcUh+A==", + "cpu": [ + "riscv64" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-linux-s390x": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-linux-s390x/-/esbuild-linux-s390x-0.15.1.tgz", + "integrity": "sha512-TScRbO4mi4AUUXzIQ8sb6ZXhGkCb/PlJ82qFfBE6xxsioae/d6XaSdaha/+OUTvmPeoro3lNf3vwdw27v3wEgw==", + "cpu": [ + "s390x" + ], + "dev": true, + "optional": true, + "os": [ + "linux" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-netbsd-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-netbsd-64/-/esbuild-netbsd-64-0.15.1.tgz", + "integrity": "sha512-ES2pbK8QfsMZbdPkgjkLwWfnEGtPa0vYzVFLQn7GFgP+RiemY+ulH7WWQ8ezMt9rZl4XAR3y14yKLGX0gsBLaw==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "netbsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-openbsd-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-openbsd-64/-/esbuild-openbsd-64-0.15.1.tgz", + "integrity": "sha512-DxNWji11AxSEny4HzSKu21Skia8tEPQI1N+XO/RqVOJComOvsFLq+QeooKsK2caOsQIKl9mO14Hh+px+zFabMA==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "openbsd" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-sunos-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-sunos-64/-/esbuild-sunos-64-0.15.1.tgz", + "integrity": "sha512-lwZoWlv893qtQQx5H4QQCh2mcYzGbxEz09ESFdd4cHcUCfjb193bSAy6jPxW2efBx2fHEo2sw43TRtAkpCf+XQ==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "sunos" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-windows-32": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-windows-32/-/esbuild-windows-32-0.15.1.tgz", + "integrity": "sha512-jEFz8DxP+Hh67fk9XMoyLUqPjjoCT6m4bnl36aze0XpPZDuQm0SBDlG/ciOBCjzHDsu/MYUNwxVezvUT3sXh1A==", + "cpu": [ + "ia32" + ], + "dev": true, + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-windows-64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-windows-64/-/esbuild-windows-64-0.15.1.tgz", + "integrity": "sha512-bUetnfw4xXKBTOQx4sTzoENJVEdgAN29ZTLRtnMseRzsMO8pjObQMsRPpPL3Cstt6FJhj3k3uScHc5VnfC9QkA==", + "cpu": [ + "x64" + ], + "dev": true, + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, + "node_modules/esbuild-windows-arm64": { + "version": "0.15.1", + "resolved": "https://registry.npmjs.org/esbuild-windows-arm64/-/esbuild-windows-arm64-0.15.1.tgz", + "integrity": "sha512-oN0JMj7fQZOiqJ/f/wc8lkxjvWwj5Yz0ZhOeU90JFaPZAfafNnysi6GS95glY5uwLUUJz/RNc84cb0dK2qT89A==", + "cpu": [ + "arm64" + ], + "dev": true, + "optional": true, + "os": [ + "win32" + ], + "engines": { + "node": ">=12" + } + }, "node_modules/escalade": { "version": "3.1.1", "resolved": "https://registry.npmjs.org/escalade/-/escalade-3.1.1.tgz", @@ -3413,14 +3731,6 @@ "node": ">=0.10.0" } }, - "node_modules/process": { - "version": "0.11.10", - "resolved": "https://registry.npmjs.org/process/-/process-0.11.10.tgz", - "integrity": "sha512-cdGef/drWFoydD1JsMzuFf8100nZl+GT+yacc2bEced5f9Rjk4z+WtFUTBu9PhOi9j/jfmBPu0mMEY4wIdAF8A==", - "engines": { - "node": ">= 0.6.0" - } - }, "node_modules/process-nextick-args": { "version": "2.0.1", "resolved": "https://registry.npmjs.org/process-nextick-args/-/process-nextick-args-2.0.1.tgz", diff --git a/spago.dhall b/spago.dhall index 37c0d09e5..9cb2c46e8 100644 --- a/spago.dhall +++ b/spago.dhall @@ -16,6 +16,7 @@ You can edit this file as you like. , "either" , "exceptions" , "exists" + , "fast-vect" , "foldable-traversable" , "foreign-object" , "heterogeneous" diff --git a/yarn.lock b/yarn.lock index e7b810a92..9f652888a 100644 --- a/yarn.lock +++ b/yarn.lock @@ -24,12 +24,12 @@ "@lezer/lr" "^1.0.0" style-mod "^4.0.0" -"@codemirror/state@6.2.0", "@codemirror/state@^6.0.0", "@codemirror/state@^6.1.4", "@codemirror/state@^6.2.0": +"@codemirror/state@^6.0.0", "@codemirror/state@^6.1.4", "@codemirror/state@^6.2.0", "@codemirror/state@6.2.0": version "6.2.0" resolved "https://registry.npmjs.org/@codemirror/state/-/state-6.2.0.tgz" integrity sha512-69QXtcrsc3RYtOtd+GsvczJ319udtBf1PTrr2KbLWM/e2CXUPnh0Nz9AUo8WfhSQ7GeL8dPVNUmhQVgpmuaNGA== -"@codemirror/view@6.9.3", "@codemirror/view@^6.0.0": +"@codemirror/view@^6.0.0", "@codemirror/view@6.9.3": version "6.9.3" resolved "https://registry.npmjs.org/@codemirror/view/-/view-6.9.3.tgz" integrity sha512-BJ5mvEIhFM+SrNwc5X8pLIvMM9ffjkviVbxpg84Xk2OE8ZyKaEbId8kX+nAYEEso7+qnbwsXe1bkAHsasebMow== @@ -43,11 +43,6 @@ resolved "https://registry.npmjs.org/@colors/colors/-/colors-1.5.0.tgz" integrity sha512-ooWCrlZP11i8GImSjTHYHLkvFDP48nS4+204nGb1RiX/WXYHmJA2III9/e2DWVabCESdW7hBAEzHRqUn9OUVvQ== -"@esbuild/linux-loong64@0.15.1": - version "0.15.1" - resolved "https://registry.yarnpkg.com/@esbuild/linux-loong64/-/linux-loong64-0.15.1.tgz#f293d9442201fa7448248f05590139bb8e521856" - integrity sha512-1tORADNFK9QS4KYyUyh3Td9WGrdiI1rSoKvY6A43+9G0kPujBuT4lIGyoK0AweOSO1aRIR28xQUfiJCUa78bUw== - "@gar/promisify@^1.0.1", "@gar/promisify@^1.1.3": version "1.1.3" resolved "https://registry.npmjs.org/@gar/promisify/-/promisify-1.1.3.tgz" @@ -152,7 +147,7 @@ accepts@~1.3.4: mime-types "~2.1.24" negotiator "0.6.2" -agent-base@6, agent-base@^6.0.2: +agent-base@^6.0.2, agent-base@6: version "6.0.2" resolved "https://registry.npmjs.org/agent-base/-/agent-base-6.0.2.tgz" integrity sha512-RZNwNclF7+MS/8bDg70amg32dyeZGZxiDuQmZxKLAlQjr3jGyLx+4Kkk58UO7D2QdgFIQCovuSuZESne6RG6XQ== @@ -267,7 +262,7 @@ balanced-match@^1.0.0: resolved "https://registry.npmjs.org/balanced-match/-/balanced-match-1.0.0.tgz" integrity sha1-ibTRmasr7kneFk6gK4nORi1xt2c= -base64id@2.0.0, base64id@~2.0.0: +base64id@~2.0.0, base64id@2.0.0: version "2.0.0" resolved "https://registry.npmjs.org/base64id/-/base64id-2.0.0.tgz" integrity sha512-lGe34o6EHj9y3Kts9R4ZYs/Gr+6N7MCaMlIFA3F1R2O5/m7K06AxfSeO5530PEERE6/WyEg3lsuyw4GHlPZHog== @@ -438,7 +433,7 @@ chalk@^4.1.0: ansi-styles "^4.1.0" supports-color "^7.1.0" -chokidar@3.5.3, chokidar@^3.5.1: +chokidar@^3.5.1, chokidar@3.5.3: version "3.5.3" resolved "https://registry.npmjs.org/chokidar/-/chokidar-3.5.3.tgz" integrity sha512-Dr3sfKRP6oTcjf2JmUmFJfeVMvXBdegxB0iVQ5eb2V10uFJUCAS8OByZdVAyVb8xXNz3GjjTgj9kLWsZTqE6kw== @@ -498,17 +493,17 @@ color-convert@^2.0.1: dependencies: color-name "~1.1.4" -color-name@1.1.3: - version "1.1.3" - resolved "https://registry.npmjs.org/color-name/-/color-name-1.1.3.tgz" - integrity sha1-p9BVi9icQveV3UIyj3QIMcpTvCU= - color-name@~1.1.4: version "1.1.4" resolved "https://registry.npmjs.org/color-name/-/color-name-1.1.4.tgz" integrity sha512-dOy+3AuW3a2wNbZHIuMZpTcgjGuLU/uBL/ubcZF9OXbDo8ff4O8yVp5Bf0efS8uEoYo5q4Fx7dY9OgQGXgAsQA== -commander@2, commander@^2.18.0: +color-name@1.1.3: + version "1.1.3" + resolved "https://registry.npmjs.org/color-name/-/color-name-1.1.3.tgz" + integrity sha1-p9BVi9icQveV3UIyj3QIMcpTvCU= + +commander@^2.18.0, commander@2: version "2.20.3" resolved "https://registry.npmjs.org/commander/-/commander-2.20.3.tgz" integrity sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ== @@ -602,7 +597,7 @@ cyclist@^1.0.1: resolved "https://registry.npmjs.org/cyclist/-/cyclist-1.0.2.tgz" integrity sha512-0sVXIohTfLqVIW3kb/0n6IiWF3Ifj5nm2XaSrLq2DI6fKIGa2fYAZdk917rUneaeLVpYfFcyXE2ft0fe3remsA== -d3-array@2, d3-array@>=2.5, d3-array@^2.3.0: +d3-array@^2.3.0, d3-array@>=2.5, d3-array@2: version "2.12.1" resolved "https://registry.npmjs.org/d3-array/-/d3-array-2.12.1.tgz" integrity sha512-B0ErZK/66mHtEsR1TkPEEkwdy+WDesimkM5gpZr5Dsg54BiTA5RXtYW5qTLIAcekaS9xfZrzBLF/OAkB3Qn1YQ== @@ -762,16 +757,16 @@ d3-scale@3: d3-time "^2.1.1" d3-time-format "2 - 3" -d3-selection@2: - version "2.0.0" - resolved "https://registry.npmjs.org/d3-selection/-/d3-selection-2.0.0.tgz" - integrity sha512-XoGGqhLUN/W14NmaqcO/bb1nqjDAw5WtSYb2X8wiuQWvSZUsUVYsOSkOybUrNvcBjaywBdYPy03eXHMXjk9nZA== - d3-selection@^1.3.0: version "1.4.2" resolved "https://registry.npmjs.org/d3-selection/-/d3-selection-1.4.2.tgz" integrity sha512-SJ0BqYihzOjDnnlfyeHT0e30k0K1+5sR3d5fNueCNeuhZTnGw4M4o8mqJchSwgKMXCNFo+e2VTChiSJ0vYtXkg== +d3-selection@2: + version "2.0.0" + resolved "https://registry.npmjs.org/d3-selection/-/d3-selection-2.0.0.tgz" + integrity sha512-XoGGqhLUN/W14NmaqcO/bb1nqjDAw5WtSYb2X8wiuQWvSZUsUVYsOSkOybUrNvcBjaywBdYPy03eXHMXjk9nZA== + d3-shape@2: version "2.1.0" resolved "https://registry.npmjs.org/d3-shape/-/d3-shape-2.1.0.tgz" @@ -786,7 +781,7 @@ d3-shape@2: dependencies: d3-time "1 - 2" -"d3-time@1 - 2", d3-time@2, d3-time@^2.1.1: +d3-time@^2.1.1, "d3-time@1 - 2", d3-time@2: version "2.1.1" resolved "https://registry.npmjs.org/d3-time/-/d3-time-2.1.1.tgz" integrity sha512-/eIQe/eR4kCQwq7yxi7z4c6qEXf2IYGcjoWB5OOQy4Tq9Uv39/947qlDcN2TLkiTzQWzvnsuYPB9TrWaNfipKQ== @@ -876,20 +871,6 @@ datetime@^0.0.3: dependencies: vows ">=0.5.4" -debug@2.6.9: - version "2.6.9" - resolved "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz" - integrity sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA== - dependencies: - ms "2.0.0" - -debug@4, debug@4.3.4, debug@^4.3.3, debug@^4.3.4, debug@~4.3.1, debug@~4.3.2: - version "4.3.4" - resolved "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz" - integrity sha512-PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ== - dependencies: - ms "2.1.2" - debug@^3.0.0: version "3.2.6" resolved "https://registry.npmjs.org/debug/-/debug-3.2.6.tgz" @@ -904,6 +885,20 @@ debug@^4.1.0: dependencies: ms "2.1.2" +debug@^4.3.3, debug@^4.3.4, debug@~4.3.1, debug@~4.3.2, debug@4, debug@4.3.4: + version "4.3.4" + resolved "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz" + integrity sha512-PRWFHuSU3eDtQJPvnNY7Jcket1j0t5OuOsFzPPzsekD52Zl8qUfFIPEiswXqIvHWGVHOgX+7G/vCNNhehwxfkQ== + dependencies: + ms "2.1.2" + +debug@2.6.9: + version "2.6.9" + resolved "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz" + integrity sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA== + dependencies: + ms "2.0.0" + decamelize@^4.0.0: version "4.0.0" resolved "https://registry.npmjs.org/decamelize/-/decamelize-4.0.0.tgz" @@ -924,16 +919,16 @@ di@^0.0.1: resolved "https://registry.npmjs.org/di/-/di-0.0.1.tgz" integrity sha1-gGZJMmzqp8qjMG112YXqJ0i6kTw= -diff@5.0.0: - version "5.0.0" - resolved "https://registry.npmjs.org/diff/-/diff-5.0.0.tgz" - integrity sha512-/VTCrvm5Z0JGty/BWHljh+BAiw3IK+2j87NGMu8Nwc/f48WoDAC395uomO9ZD117ZOBaHmkX1oyLvkVM/aIT3w== - diff@^4.0.1: version "4.0.2" resolved "https://registry.npmjs.org/diff/-/diff-4.0.2.tgz" integrity sha512-58lmxKSA4BNyLz+HHMUzlOEpg09FV+ev6ZMe3vJihgdxzgcwZ8VoEEPmALCZG9LmqfVoNMMKpttIYTVG6uDY7A== +diff@5.0.0: + version "5.0.0" + resolved "https://registry.npmjs.org/diff/-/diff-5.0.0.tgz" + integrity sha512-/VTCrvm5Z0JGty/BWHljh+BAiw3IK+2j87NGMu8Nwc/f48WoDAC395uomO9ZD117ZOBaHmkX1oyLvkVM/aIT3w== + dom-serialize@^2.2.1: version "2.2.1" resolved "https://registry.npmjs.org/dom-serialize/-/dom-serialize-2.2.1.tgz" @@ -1024,106 +1019,11 @@ err-code@^2.0.2: resolved "https://registry.npmjs.org/err-code/-/err-code-2.0.3.tgz" integrity sha512-2bmlRpNKBxT/CRmPOlyISQpNj+qSeYvcym/uT0Jx2bMOlKLtSy1ZmLuVxSEKKyor/N5yhvp/ZiG1oE3DEYMSFA== -esbuild-android-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-android-64/-/esbuild-android-64-0.15.1.tgz#f609a37348a3784ae632e88517d2e5f579984806" - integrity sha512-q5kkJZsgLIkyh5e2ZJl4/kXKIueBKtjVMEihP9WCHadqhH6+F9qiycE7fBwUb/g2B15mYlmMBXjp8VmOT3J2gA== - -esbuild-android-arm64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-android-arm64/-/esbuild-android-arm64-0.15.1.tgz#94b064dfa87bacbfb623313ead8338d357175a10" - integrity sha512-IQuZOzqMaFceLlKJJA27CXAdh+Mzh2ZblHMmcNIu/wxb6iX1zgYXlPWle62iHnmNCtfAux1mzQvmNsP9aLhemA== - -esbuild-darwin-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-darwin-64/-/esbuild-darwin-64-0.15.1.tgz#d15ed63dada464c18a8245199294df5b22c865ff" - integrity sha512-tyouWLyxwM/Y2fy/reuIvAvVB+KVQwuY9IVyV7LH5CGkJYxgtLb8xVEiwHFF8TG2uo9a2fqdgWffados4YA6Aw== - -esbuild-darwin-arm64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-darwin-arm64/-/esbuild-darwin-arm64-0.15.1.tgz#c8c6a8949faa88cccbc508143662d53a111d7ee0" - integrity sha512-fb4V1eB1nir3zJwsS75itsbahkbM71XuqUDJVH8iyBLS8VIQD7MWWAAekea2l9keueGfsn0+wTyDluMT+kg8Cw== - -esbuild-freebsd-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-freebsd-64/-/esbuild-freebsd-64-0.15.1.tgz#4ebbbd954e2e72cf35e78185f4da810a8c3fce2f" - integrity sha512-1KxEv/FUPlQtUSOjFCwR8FVNEskB5LmkbfW9FNJ7lhpG+4RsLiHWw4Sl2Y1/S+aKX7inyWxLA05zYV6XAzO8DA== - -esbuild-freebsd-arm64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-freebsd-arm64/-/esbuild-freebsd-arm64-0.15.1.tgz#a377942ed5b2578f9d8e8aea1396db59df5e1742" - integrity sha512-ueUMGSNrcuHwAadioxBdfOCO4+bTVeI68a147BQ/AFFIrf4XJNow4UXxguvQlZO+ZYaVz6EztaL6mHslKie2Rw== - -esbuild-linux-32@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-32/-/esbuild-linux-32-0.15.1.tgz#7226edd9517ee0bdc0ea7a8be1b5047d31de9426" - integrity sha512-K5WWcN2OZkZ6arFN3+hi1leKc0at9ukKGrXK9Ia94kQOesBphTSmsNK/Gy/AoVoIa0bWrHtxDijS9j9+dz86oA== - esbuild-linux-64@0.15.1: version "0.15.1" resolved "https://registry.npmjs.org/esbuild-linux-64/-/esbuild-linux-64-0.15.1.tgz" integrity sha512-+haiVm83DfRi9x8M+GgR4f4LtSN8lnEIG8XMGK8/FYpkYNQiKb398GxeHp2yvoMpX8IPvmWCt215tAm5BBNfZQ== -esbuild-linux-arm64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-arm64/-/esbuild-linux-arm64-0.15.1.tgz#4a33a9b9dc95d537264aaf05a3e3fdbf6fb8cce5" - integrity sha512-TP0BCVZEVu/aoVaZe2sn1vpvo63j0LPiH8rvd7AegqOfTwb+mcxLxpgyYwkibafUCMxnIrKdUTsSJeusoMhcLg== - -esbuild-linux-arm@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-arm/-/esbuild-linux-arm-0.15.1.tgz#31773327a2c8edfd77c7cf12ded141b2db0b25c6" - integrity sha512-qjAkEDcFhVNYwG2xgaDg/hA8JABoMvjzAzE6g1K8kR516oNkKbVf6rN68UrsQaV1zq1qR3dbVeMv/Ul2bheppA== - -esbuild-linux-mips64le@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-mips64le/-/esbuild-linux-mips64le-0.15.1.tgz#714b8c49886349d2a599f05fae5cb7dc5e574658" - integrity sha512-8vzQzp+kwrn1Y+OjvfFaLS8uL8aR39WnAtxOHwjB72s9g18kHFlE8IQLS9dWDQgKpBSFq9kazsJE65dSVmz+VA== - -esbuild-linux-ppc64le@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-ppc64le/-/esbuild-linux-ppc64le-0.15.1.tgz#5df1ec88d850745de2ce23d1a4117d04d36b8a32" - integrity sha512-QlWSOgC2Ad53Xvf7ZivXU7wM2y29YhQUrd50PjK0QJ3psh/eYSQx77PTe1iWm7Ovjiqv1wPKEAyC7CbyJUgriw== - -esbuild-linux-riscv64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-riscv64/-/esbuild-linux-riscv64-0.15.1.tgz#3ccf408ec4682630862310e28038d30639e2623c" - integrity sha512-/PRNgNsiwb7G2n3rB5WcHinCwKj0OqUmtu8cdakV4CLNWnFnfChEGEJX1x5n8RcGD3xPUlI5CgqFe0/oBcUh+A== - -esbuild-linux-s390x@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-linux-s390x/-/esbuild-linux-s390x-0.15.1.tgz#1340260371f01703fe91376d9550f0bcf709d7a4" - integrity sha512-TScRbO4mi4AUUXzIQ8sb6ZXhGkCb/PlJ82qFfBE6xxsioae/d6XaSdaha/+OUTvmPeoro3lNf3vwdw27v3wEgw== - -esbuild-netbsd-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-netbsd-64/-/esbuild-netbsd-64-0.15.1.tgz#b3c31b64a88379d0a16f44ffc66a0c879a4105ae" - integrity sha512-ES2pbK8QfsMZbdPkgjkLwWfnEGtPa0vYzVFLQn7GFgP+RiemY+ulH7WWQ8ezMt9rZl4XAR3y14yKLGX0gsBLaw== - -esbuild-openbsd-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-openbsd-64/-/esbuild-openbsd-64-0.15.1.tgz#2447e8734a8fccfa91f4cbfc2816b09ec38d468f" - integrity sha512-DxNWji11AxSEny4HzSKu21Skia8tEPQI1N+XO/RqVOJComOvsFLq+QeooKsK2caOsQIKl9mO14Hh+px+zFabMA== - -esbuild-sunos-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-sunos-64/-/esbuild-sunos-64-0.15.1.tgz#bca632708b8fc124a15477433ad2ae22f3726e0d" - integrity sha512-lwZoWlv893qtQQx5H4QQCh2mcYzGbxEz09ESFdd4cHcUCfjb193bSAy6jPxW2efBx2fHEo2sw43TRtAkpCf+XQ== - -esbuild-windows-32@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-windows-32/-/esbuild-windows-32-0.15.1.tgz#c5577ed48901075772db1332ed5098b0a3cf6e2f" - integrity sha512-jEFz8DxP+Hh67fk9XMoyLUqPjjoCT6m4bnl36aze0XpPZDuQm0SBDlG/ciOBCjzHDsu/MYUNwxVezvUT3sXh1A== - -esbuild-windows-64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-windows-64/-/esbuild-windows-64-0.15.1.tgz#4fd2d9c62b37e98adff350a2763622c5c0e27c21" - integrity sha512-bUetnfw4xXKBTOQx4sTzoENJVEdgAN29ZTLRtnMseRzsMO8pjObQMsRPpPL3Cstt6FJhj3k3uScHc5VnfC9QkA== - -esbuild-windows-arm64@0.15.1: - version "0.15.1" - resolved "https://registry.yarnpkg.com/esbuild-windows-arm64/-/esbuild-windows-arm64-0.15.1.tgz#6243dd249fccb7b6993096da51173d97a2714b37" - integrity sha512-oN0JMj7fQZOiqJ/f/wc8lkxjvWwj5Yz0ZhOeU90JFaPZAfafNnysi6GS95glY5uwLUUJz/RNc84cb0dK2qT89A== - esbuild@0.15.1: version "0.15.1" resolved "https://registry.npmjs.org/esbuild/-/esbuild-0.15.1.tgz" @@ -1161,16 +1061,16 @@ escape-html@~1.0.3: resolved "https://registry.npmjs.org/escape-html/-/escape-html-1.0.3.tgz" integrity sha1-Aljq5NPQwJdN4cFpGI7wBR0dGYg= -escape-string-regexp@4.0.0: - version "4.0.0" - resolved "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-4.0.0.tgz" - integrity sha512-TtpcNJ3XAzx3Gq8sWRzJaVajRs0uVxA2YAkdb1jm2YkPz4G6egUFAyA3n5vtEIZefPk5Wa4UXbKuS5fKkJWdgA== - escape-string-regexp@^1.0.2, escape-string-regexp@^1.0.5: version "1.0.5" resolved "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-1.0.5.tgz" integrity sha1-G2HAViGQqN/2rjuyzwIAyhMLhtQ= +escape-string-regexp@4.0.0: + version "4.0.0" + resolved "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-4.0.0.tgz" + integrity sha512-TtpcNJ3XAzx3Gq8sWRzJaVajRs0uVxA2YAkdb1jm2YkPz4G6egUFAyA3n5vtEIZefPk5Wa4UXbKuS5fKkJWdgA== + eventemitter3@^4.0.0: version "4.0.4" resolved "https://registry.npmjs.org/eventemitter3/-/eventemitter3-4.0.4.tgz" @@ -1262,14 +1162,6 @@ find-cache-dir@^3.3.1: make-dir "^3.0.2" pkg-dir "^4.1.0" -find-up@5.0.0: - version "5.0.0" - resolved "https://registry.npmjs.org/find-up/-/find-up-5.0.0.tgz" - integrity sha512-78/PXT1wlLLDgTzDs7sjq9hzz0vXD+zn+7wypEe4fXQxCmdmqfGsEPQxmiCSQI3ajFV91bVSsvNtrJRiW6nGng== - dependencies: - locate-path "^6.0.0" - path-exists "^4.0.0" - find-up@^4.0.0: version "4.1.0" resolved "https://registry.npmjs.org/find-up/-/find-up-4.1.0.tgz" @@ -1278,6 +1170,14 @@ find-up@^4.0.0: locate-path "^5.0.0" path-exists "^4.0.0" +find-up@5.0.0: + version "5.0.0" + resolved "https://registry.npmjs.org/find-up/-/find-up-5.0.0.tgz" + integrity sha512-78/PXT1wlLLDgTzDs7sjq9hzz0vXD+zn+7wypEe4fXQxCmdmqfGsEPQxmiCSQI3ajFV91bVSsvNtrJRiW6nGng== + dependencies: + locate-path "^6.0.0" + path-exists "^4.0.0" + flat@^5.0.2: version "5.0.2" resolved "https://registry.npmjs.org/flat/-/flat-5.0.2.tgz" @@ -1342,11 +1242,6 @@ fs.realpath@^1.0.0: resolved "https://registry.npmjs.org/fs.realpath/-/fs.realpath-1.0.0.tgz" integrity sha1-FQStJSMVjKpA20onh8sBQRmU6k8= -fsevents@~2.3.2: - version "2.3.3" - resolved "https://registry.yarnpkg.com/fsevents/-/fsevents-2.3.3.tgz#cac6407785d03675a2a5e1a5305c697b347d90d6" - integrity sha512-5xoDfX+fL7faATnagmWPpbFtwh/R77WmMMqqHGS65C3vvB0YHrgF+B1YmZ3441tMj5n63k0212XNoJwzlhffQw== - get-caller-file@^2.0.5: version "2.0.5" resolved "https://registry.npmjs.org/get-caller-file/-/get-caller-file-2.0.5.tgz" @@ -1379,18 +1274,6 @@ glob-parent@~5.1.2: dependencies: is-glob "^4.0.1" -glob@7.2.0: - version "7.2.0" - resolved "https://registry.npmjs.org/glob/-/glob-7.2.0.tgz" - integrity sha512-lmLf6gtyrPq8tTjSmrO94wBeQbFR3HbLHbuyD69wuyQkImp2hWqMGB47OX65FBkPffO641IP9jWa1z4ivqG26Q== - dependencies: - fs.realpath "^1.0.0" - inflight "^1.0.4" - inherits "2" - minimatch "^3.0.4" - once "^1.3.0" - path-is-absolute "^1.0.0" - glob@^7.0.3, glob@^7.1.2, glob@^7.1.3, glob@^7.1.4: version "7.1.6" resolved "https://registry.npmjs.org/glob/-/glob-7.1.6.tgz" @@ -1426,6 +1309,18 @@ glob@^8.0.1: minimatch "^5.0.1" once "^1.3.0" +glob@7.2.0: + version "7.2.0" + resolved "https://registry.npmjs.org/glob/-/glob-7.2.0.tgz" + integrity sha512-lmLf6gtyrPq8tTjSmrO94wBeQbFR3HbLHbuyD69wuyQkImp2hWqMGB47OX65FBkPffO641IP9jWa1z4ivqG26Q== + dependencies: + fs.realpath "^1.0.0" + inflight "^1.0.4" + inherits "2" + minimatch "^3.0.4" + once "^1.3.0" + path-is-absolute "^1.0.0" + globby@^6.1.0: version "6.1.0" resolved "https://registry.npmjs.org/globby/-/globby-6.1.0.tgz" @@ -1528,13 +1423,6 @@ humanize-url@^1.0.0: normalize-url "^1.0.0" strip-url-auth "^1.0.0" -iconv-lite@0.4, iconv-lite@0.4.24: - version "0.4.24" - resolved "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.4.24.tgz" - integrity sha512-v3MXnZAcvnywkTUEZomIActle7RXXeedOR31wwl7VlyoXO4Qi9arvSenNQWne1TcRwhCL1HwLI21bEqdpj8/rA== - dependencies: - safer-buffer ">= 2.1.2 < 3" - iconv-lite@^0.6.2: version "0.6.3" resolved "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.6.3.tgz" @@ -1542,6 +1430,13 @@ iconv-lite@^0.6.2: dependencies: safer-buffer ">= 2.1.2 < 3.0.0" +iconv-lite@0.4, iconv-lite@0.4.24: + version "0.4.24" + resolved "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.4.24.tgz" + integrity sha512-v3MXnZAcvnywkTUEZomIActle7RXXeedOR31wwl7VlyoXO4Qi9arvSenNQWne1TcRwhCL1HwLI21bEqdpj8/rA== + dependencies: + safer-buffer ">= 2.1.2 < 3" + iferr@^0.1.5: version "0.1.5" resolved "https://registry.npmjs.org/iferr/-/iferr-0.1.5.tgz" @@ -1570,7 +1465,7 @@ inflight@^1.0.4: once "^1.3.0" wrappy "1" -inherits@2, inherits@^2.0.1, inherits@^2.0.3, inherits@~2.0.3: +inherits@^2.0.1, inherits@^2.0.3, inherits@~2.0.3, inherits@2: version "2.0.4" resolved "https://registry.npmjs.org/inherits/-/inherits-2.0.4.tgz" integrity sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ== @@ -1701,7 +1596,7 @@ karma-mocha@2.0.1: dependencies: minimist "^1.2.3" -karma@6.4.0: +karma@>=0.13, karma@6.4.0: version "6.4.0" resolved "https://registry.npmjs.org/karma/-/karma-6.4.0.tgz" integrity sha512-s8m7z0IF5g/bS5ONT7wsOavhW4i4aFkzD4u4wgzAQWT4HGUeWI3i21cK2Yz6jndMAeHETp5XuNsRoyGJZXVd4w== @@ -1750,14 +1645,6 @@ lodash@^4.17.14, lodash@^4.17.21, lodash@^4.17.4: resolved "https://registry.npmjs.org/lodash/-/lodash-4.17.21.tgz" integrity sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg== -log-symbols@4.1.0: - version "4.1.0" - resolved "https://registry.npmjs.org/log-symbols/-/log-symbols-4.1.0.tgz" - integrity sha512-8XPvpAA8uyhfteu8pIvQxpJZ7SYYdpUivZpGy6sFsBuKRY/7rQGavedeB8aK+Zkyq6upMFVL/9AW6vOYzfRyLg== - dependencies: - chalk "^4.1.0" - is-unicode-supported "^0.1.0" - log-symbols@^2.1.0: version "2.2.0" resolved "https://registry.npmjs.org/log-symbols/-/log-symbols-2.2.0.tgz" @@ -1772,6 +1659,14 @@ log-symbols@^3.0.0: dependencies: chalk "^2.4.2" +log-symbols@4.1.0: + version "4.1.0" + resolved "https://registry.npmjs.org/log-symbols/-/log-symbols-4.1.0.tgz" + integrity sha512-8XPvpAA8uyhfteu8pIvQxpJZ7SYYdpUivZpGy6sFsBuKRY/7rQGavedeB8aK+Zkyq6upMFVL/9AW6vOYzfRyLg== + dependencies: + chalk "^4.1.0" + is-unicode-supported "^0.1.0" + log-update@^4.0.0: version "4.0.0" resolved "https://registry.npmjs.org/log-update/-/log-update-4.0.0.tgz" @@ -1895,13 +1790,6 @@ mimic-fn@^2.1.0: resolved "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz" integrity sha512-OqbOk5oEQeAZ8WXWydlu9HJjz9WVdEIvamMCcXmuqUYjTknH/sqsWvhQ3vgwKFRR1HpjvNBKQ37nbJgYzGqGcg== -minimatch@5.0.1: - version "5.0.1" - resolved "https://registry.npmjs.org/minimatch/-/minimatch-5.0.1.tgz" - integrity sha512-nLDxIFRyhDblz3qMuq+SoRZED4+miJ/G+tdDrjkkkRnjAsBexeGpgjLEQ0blJy7rHhR2b93rhQY4SvyWu9v03g== - dependencies: - brace-expansion "^2.0.1" - minimatch@^3.0.4: version "3.0.4" resolved "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz" @@ -1923,6 +1811,13 @@ minimatch@^5.0.1: dependencies: brace-expansion "^2.0.1" +minimatch@5.0.1: + version "5.0.1" + resolved "https://registry.npmjs.org/minimatch/-/minimatch-5.0.1.tgz" + integrity sha512-nLDxIFRyhDblz3qMuq+SoRZED4+miJ/G+tdDrjkkkRnjAsBexeGpgjLEQ0blJy7rHhR2b93rhQY4SvyWu9v03g== + dependencies: + brace-expansion "^2.0.1" + minimist@^1.2.0, minimist@^1.2.3, minimist@^1.2.6: version "1.2.8" resolved "https://registry.npmjs.org/minimist/-/minimist-1.2.8.tgz" @@ -2016,7 +1911,12 @@ mkdirp@^0.5.1, mkdirp@^0.5.5: dependencies: minimist "^1.2.6" -mkdirp@^1.0.3, mkdirp@^1.0.4: +mkdirp@^1.0.3: + version "1.0.4" + resolved "https://registry.npmjs.org/mkdirp/-/mkdirp-1.0.4.tgz" + integrity sha512-vVqVZQyf3WLx2Shd0qJ9xuvqgAyKPLAiqITEtqW0oIUjzo3PePDd6fW9iFz30ef7Ysp/oiWqbhszeGWW2T6Gzw== + +mkdirp@^1.0.4: version "1.0.4" resolved "https://registry.npmjs.org/mkdirp/-/mkdirp-1.0.4.tgz" integrity sha512-vVqVZQyf3WLx2Shd0qJ9xuvqgAyKPLAiqITEtqW0oIUjzo3PePDd6fW9iFz30ef7Ysp/oiWqbhszeGWW2T6Gzw== @@ -2061,17 +1961,27 @@ move-concurrently@^1.0.1: rimraf "^2.5.4" run-queue "^1.0.3" -ms@2.0.0: - version "2.0.0" - resolved "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz" - integrity sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g= +ms@^2.0.0: + version "2.1.3" + resolved "https://registry.npmjs.org/ms/-/ms-2.1.3.tgz" + integrity sha512-6FlzubTLZG3J2a/NVCAleEhjzq5oxgHyaCU9yYXvcLsvoVaHJq/s5xXI6/XXP6tz7R9xAOtHnSO/tXtF3WRTlA== + +ms@^2.1.1: + version "2.1.3" + resolved "https://registry.npmjs.org/ms/-/ms-2.1.3.tgz" + integrity sha512-6FlzubTLZG3J2a/NVCAleEhjzq5oxgHyaCU9yYXvcLsvoVaHJq/s5xXI6/XXP6tz7R9xAOtHnSO/tXtF3WRTlA== -ms@2.1.2, ms@^2.1.2: +ms@^2.1.2, ms@2.1.2: version "2.1.2" resolved "https://registry.npmjs.org/ms/-/ms-2.1.2.tgz" integrity sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w== -ms@2.1.3, ms@^2.0.0, ms@^2.1.1: +ms@2.0.0: + version "2.0.0" + resolved "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz" + integrity sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g= + +ms@2.1.3: version "2.1.3" resolved "https://registry.npmjs.org/ms/-/ms-2.1.3.tgz" integrity sha512-6FlzubTLZG3J2a/NVCAleEhjzq5oxgHyaCU9yYXvcLsvoVaHJq/s5xXI6/XXP6tz7R9xAOtHnSO/tXtF3WRTlA== @@ -2081,16 +1991,16 @@ nanoid@3.3.3: resolved "https://registry.npmjs.org/nanoid/-/nanoid-3.3.3.tgz" integrity sha512-p1sjXuopFs0xg+fPASzQ28agW1oHD7xDsd9Xkf3T15H3c/cifrFHVwrh74PdoklAPi+i7MdRsE47vm2r6JoB+w== -negotiator@0.6.2: - version "0.6.2" - resolved "https://registry.npmjs.org/negotiator/-/negotiator-0.6.2.tgz" - integrity sha512-hZXc7K2e+PgeI1eDBe/10Ard4ekbfrrqG8Ep+8Jmf4JID2bNg7NvCPOZN+kfF574pFQI7mum2AUqDidoKqcTOw== - negotiator@^0.6.2, negotiator@^0.6.3: version "0.6.3" resolved "https://registry.npmjs.org/negotiator/-/negotiator-0.6.3.tgz" integrity sha512-+EUsqGPLsM+j/zdChZjsnX51g4XrHFOIXwfnCVPGlQk/k5giakcKsuxCObBRu6DSm9opw/O6slWbJdghQM4bBg== +negotiator@0.6.2: + version "0.6.2" + resolved "https://registry.npmjs.org/negotiator/-/negotiator-0.6.2.tgz" + integrity sha512-hZXc7K2e+PgeI1eDBe/10Ard4ekbfrrqG8Ep+8Jmf4JID2bNg7NvCPOZN+kfF574pFQI7mum2AUqDidoKqcTOw== + normalize-path@^3.0.0, normalize-path@~3.0.0: version "3.0.0" resolved "https://registry.npmjs.org/normalize-path/-/normalize-path-3.0.0.tgz" @@ -2394,7 +2304,7 @@ raw-body@2.4.0: iconv-lite "0.4.24" unpipe "1.0.0" -"readable-stream@1 || 2", readable-stream@^2.0.0, readable-stream@^2.1.5, readable-stream@^2.2.2, readable-stream@^2.3.6, readable-stream@~2.3.6: +readable-stream@^2.0.0, readable-stream@^2.1.5, readable-stream@^2.2.2, readable-stream@^2.3.6, readable-stream@~2.3.6, "readable-stream@1 || 2": version "2.3.8" resolved "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz" integrity sha512-8p0AUk4XODgIewSi0l8Epjs+EVnWiK7NoDIEGU0HhE7+ZyY8D1IMY7odu5lRrFXGg71L15KG8QrPmum45RTtdA== @@ -2449,7 +2359,14 @@ rimraf@^2.5.4, rimraf@^2.6.3: dependencies: glob "^7.1.3" -rimraf@^3.0.0, rimraf@^3.0.2: +rimraf@^3.0.0: + version "3.0.2" + resolved "https://registry.npmjs.org/rimraf/-/rimraf-3.0.2.tgz" + integrity sha512-JZkJMZkAGFFPP2YqXZXPbMlMBgsxzE8ILs4lMIX/2o0L9UBw9O/Y3o6wFw/i9YLapcUJWwqbi3kdxIPdC62TIA== + dependencies: + glob "^7.1.3" + +rimraf@^3.0.2: version "3.0.2" resolved "https://registry.npmjs.org/rimraf/-/rimraf-3.0.2.tgz" integrity sha512-JZkJMZkAGFFPP2YqXZXPbMlMBgsxzE8ILs4lMIX/2o0L9UBw9O/Y3o6wFw/i9YLapcUJWwqbi3kdxIPdC62TIA== @@ -2473,7 +2390,12 @@ safe-buffer@^5.1.0: resolved "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz" integrity sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ== -safe-buffer@~5.1.0, safe-buffer@~5.1.1: +safe-buffer@~5.1.0: + version "5.1.2" + resolved "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz" + integrity sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g== + +safe-buffer@~5.1.1: version "5.1.2" resolved "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz" integrity sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g== @@ -2668,6 +2590,13 @@ strict-uri-encode@^1.0.0: resolved "https://registry.npmjs.org/strict-uri-encode/-/strict-uri-encode-1.1.0.tgz" integrity sha1-J5siXfHVgrH1TmWt3UNS4Y+qBxM= +string_decoder@~1.1.1: + version "1.1.1" + resolved "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz" + integrity sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg== + dependencies: + safe-buffer "~5.1.0" + string-width@^4.1.0, string-width@^4.2.0: version "4.2.0" resolved "https://registry.npmjs.org/string-width/-/string-width-4.2.0.tgz" @@ -2677,13 +2606,6 @@ string-width@^4.1.0, string-width@^4.2.0: is-fullwidth-code-point "^3.0.0" strip-ansi "^6.0.0" -string_decoder@~1.1.1: - version "1.1.1" - resolved "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz" - integrity sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg== - dependencies: - safe-buffer "~5.1.0" - strip-ansi@^4.0.0: version "4.0.0" resolved "https://registry.npmjs.org/strip-ansi/-/strip-ansi-4.0.0.tgz" @@ -2725,13 +2647,6 @@ style-mod@^4.0.0: resolved "https://registry.npmjs.org/style-mod/-/style-mod-4.0.2.tgz" integrity sha512-C4myMmRTO8iaC5Gg+N1ftK2WT4eXUTMAa+HEFPPrfVeO/NtqLTtAmV1HbqnuGtLwCek44Ra76fdGUkSqjiMPcQ== -supports-color@8.1.1: - version "8.1.1" - resolved "https://registry.npmjs.org/supports-color/-/supports-color-8.1.1.tgz" - integrity sha512-MpUEN2OodtUzxvKQl72cUF7RQ5EiHsGvSsVG0ia9c5RbWGL2CI4C7EpPS8UTBIplnlzZiNuV56w+FuNxy3ty2Q== - dependencies: - has-flag "^4.0.0" - supports-color@^5.3.0: version "5.5.0" resolved "https://registry.npmjs.org/supports-color/-/supports-color-5.5.0.tgz" @@ -2746,6 +2661,13 @@ supports-color@^7.1.0: dependencies: has-flag "^4.0.0" +supports-color@8.1.1: + version "8.1.1" + resolved "https://registry.npmjs.org/supports-color/-/supports-color-8.1.1.tgz" + integrity sha512-MpUEN2OodtUzxvKQl72cUF7RQ5EiHsGvSsVG0ia9c5RbWGL2CI4C7EpPS8UTBIplnlzZiNuV56w+FuNxy3ty2Q== + dependencies: + has-flag "^4.0.0" + tar@^6.0.2, tar@^6.1.11: version "6.1.11" resolved "https://registry.npmjs.org/tar/-/tar-6.1.11.tgz" @@ -2848,7 +2770,7 @@ universalify@^0.1.0: resolved "https://registry.npmjs.org/universalify/-/universalify-0.1.2.tgz" integrity sha512-rBJeI5CXAlmy1pV+617WB9J63U6XcazHHF2f2dbJix4XzpUF0RS3Zbj0FGIOCAva5P/d/GBOYaACQ1w+0azUkg== -unpipe@1.0.0, unpipe@~1.0.0: +unpipe@~1.0.0, unpipe@1.0.0: version "1.0.0" resolved "https://registry.npmjs.org/unpipe/-/unpipe-1.0.0.tgz" integrity sha1-sr9O6FFKrmFltIF4KdIbLvSZBOw= @@ -2887,7 +2809,7 @@ vows@>=0.5.4: eyes "~0.1.6" glob "^7.1.2" -vscode-jsonrpc@8.0.2, vscode-jsonrpc@^8.0.0-next.2: +vscode-jsonrpc@^8.0.0-next.2, vscode-jsonrpc@8.0.2: version "8.0.2" resolved "https://registry.npmjs.org/vscode-jsonrpc/-/vscode-jsonrpc-8.0.2.tgz" integrity sha512-RY7HwI/ydoC1Wwg4gJ3y6LpU9FJRZAUnTYMXthqhFXXu77ErDd/xkREpGuk4MyYkk4a+XDWAMqe0S3KkelYQEQ== @@ -2934,7 +2856,14 @@ which@^1.2.1, which@^1.3.1: dependencies: isexe "^2.0.0" -which@^2.0.1, which@^2.0.2: +which@^2.0.1: + version "2.0.2" + resolved "https://registry.npmjs.org/which/-/which-2.0.2.tgz" + integrity sha512-BLI3Tl1TW3Pvl70l3yq3Y64i+awpwXqsGBYWkkqMtnbXgrMD+yj7rhW0kuEDxzJaYXGjEW5ogapKNMEKNMjibA== + dependencies: + isexe "^2.0.0" + +which@^2.0.2: version "2.0.2" resolved "https://registry.npmjs.org/which/-/which-2.0.2.tgz" integrity sha512-BLI3Tl1TW3Pvl70l3yq3Y64i+awpwXqsGBYWkkqMtnbXgrMD+yj7rhW0kuEDxzJaYXGjEW5ogapKNMEKNMjibA== @@ -2999,16 +2928,16 @@ yallist@^4.0.0: resolved "https://registry.npmjs.org/yallist/-/yallist-4.0.0.tgz" integrity sha512-3wdGidZyq5PB084XLES5TpOSRA3wjXAlIWMhum2kRcv/41Sn2emQ0dycQW4uZXLejwKvg6EsvbdlVL+FYEct7A== -yargs-parser@20.2.4: - version "20.2.4" - resolved "https://registry.npmjs.org/yargs-parser/-/yargs-parser-20.2.4.tgz" - integrity sha512-WOkpgNhPTlE73h4VFAFsOnomJVaovO8VqLDzy5saChRBFQFBoMYirowyW+Q9HB4HFF4Z7VZTiG3iSzJJA29yRA== - yargs-parser@^20.2.2: version "20.2.9" resolved "https://registry.npmjs.org/yargs-parser/-/yargs-parser-20.2.9.tgz" integrity sha512-y11nGElTIV+CT3Zv9t7VKl+Q3hTQoT9a1Qzezhhl6Rp21gJ/IVTW7Z3y9EWXhuUBC2Shnf+DX0antecpAwSP8w== +yargs-parser@20.2.4: + version "20.2.4" + resolved "https://registry.npmjs.org/yargs-parser/-/yargs-parser-20.2.4.tgz" + integrity sha512-WOkpgNhPTlE73h4VFAFsOnomJVaovO8VqLDzy5saChRBFQFBoMYirowyW+Q9HB4HFF4Z7VZTiG3iSzJJA29yRA== + yargs-unparser@2.0.0: version "2.0.0" resolved "https://registry.npmjs.org/yargs-unparser/-/yargs-unparser-2.0.0.tgz" @@ -3019,7 +2948,7 @@ yargs-unparser@2.0.0: flat "^5.0.2" is-plain-obj "^2.1.0" -yargs@16.2.0, yargs@^16.1.1: +yargs@^16.1.1, yargs@16.2.0: version "16.2.0" resolved "https://registry.npmjs.org/yargs/-/yargs-16.2.0.tgz" integrity sha512-D1mvvtDG0L5ft/jGWkLpG1+m0eQxOfaBvTNELraWj22wSVUMWxZUvYgJYcKh6jGGIkJFhH4IZPQhR4TKpc8mBw== From 802533e63f5becce8364072fa39db69dc417cc0e Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 20 Sep 2023 11:17:24 +0100 Subject: [PATCH 02/26] RMSE implementation in terms of fast vectors --- example/Util/BMA.purs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index e69de29bb..35a318abb 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -0,0 +1,24 @@ +module Example.Util.BMA where + +import Prelude + +import Data.FastVect.FastVect (Vect) +import Data.Foldable (foldl) +import Data.Int (toNumber) +import Data.Number (pow) + +product :: forall a len. Semiring a => Vect len a -> a +product v = foldl (*) one v + +sum :: forall a len. Semiring a => Vect len a -> a +sum v = foldl (+) zero v + +vlen :: forall a len. Vect len a -> Int +vlen xs = foldl (\count _x -> (+) 1 count) 0 xs + +vlenN :: forall a len. Vect len a -> Number +vlenN = toNumber <<< vlen + +mean :: forall len. Number -> Vect len Number -> Number +mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) +mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) \ No newline at end of file From f177a0a39f7e0d78a321b8782f2c405cf3feb065 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 20 Sep 2023 12:18:46 +0100 Subject: [PATCH 03/26] Added root mean square error implementaiton --- example/Example.purs | 12 ++++++++++++ example/Util/BMA.purs | 10 +++++++++- package.json | 3 +++ spago.dhall | 2 +- 4 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 example/Example.purs diff --git a/example/Example.purs b/example/Example.purs new file mode 100644 index 000000000..3aa7f41b8 --- /dev/null +++ b/example/Example.purs @@ -0,0 +1,12 @@ +module Example.Example where + +import Prelude +import Effect (Effect) +import Effect.Class.Console (logShow) +import Example.Util.BMA (mean) +import Data.FastVect.FastVect ((:), empty) + +main :: Effect Unit +main = do + logShow "100" + logShow (mean 2.0 (1.0:2.0:3.0:4.0:5.0:6.0:7.0:8.0:9.0:10.0: empty)) \ No newline at end of file diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 35a318abb..911d78e82 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -6,6 +6,10 @@ import Data.FastVect.FastVect (Vect) import Data.Foldable (foldl) import Data.Int (toNumber) import Data.Number (pow) +-- import Effect (Effect) +-- import Effect.Class.Console (logShow) + +data IntInfty = IInt Int | Infty product :: forall a len. Semiring a => Vect len a -> a product v = foldl (*) one v @@ -21,4 +25,8 @@ vlenN = toNumber <<< vlen mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) \ No newline at end of file +mean p xs = ((1.0 / vlenN xs) * sum (map (\x -> pow x p) xs)) `pow` (1.0/p) + +-- band_matrix :: forall x y. Int -> Int -> Int -> Matrix x y IntInfty +-- band_matrix nrows ncols slack = Matrix $ empty + \ No newline at end of file diff --git a/package.json b/package.json index 3183adc66..e2ae1290d 100644 --- a/package.json +++ b/package.json @@ -7,10 +7,13 @@ "serve-app": "yarn build-app && npx http-serve dist/app -a 127.0.0.1 -c-1", "clean-tests": "rm -rf dist/tests && mkdir -p dist/tests && cp web/tests.html dist/tests", "clean-bench": "rm -rf dist/benches && mkdir -p dist/benches && cp -r fluid dist/benches && cp web/index.html dist/benches && cp -r web/css dist/benches", + "clean-examples": "rm -rf dist/examples && mkdir -p dist/examples && cp -r fluid dist/examples && cp web/index.html dist/examples && cp -r web/css dist/examples", + "build-examples": "yarn clean-examples && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Example.Example --to dist/examples/app.js", "build-tests": "yarn clean-tests && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Test.Main --to dist/tests/app.js", "build-bench": "yarn clean-bench && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Test.Benchmark --to dist/benches/app.js", "tests": "karma start karma.conf.tests.js", "bench": "npx http-serve dist/benches -a 127.0.0.1", + "examples": "npx http-serve dist/examples -a 127.0.0.1", "tests-browser": "karma start karma.conf.tests.js --browsers=Chrome --singleRun=false", "clean-app-tests": "rm -rf dist/app-tests && mkdir -p dist/app-tests && cp web/tests.html dist/app-tests", "build-app-tests": "yarn clean-app-tests && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Test.App.Main --to dist/app-tests/app.js", diff --git a/spago.dhall b/spago.dhall index 9cb2c46e8..5cabf820a 100644 --- a/spago.dhall +++ b/spago.dhall @@ -46,6 +46,6 @@ You can edit this file as you like. , "web-events" ] , packages = ./packages.dhall -, sources = [ "src/**/*.purs", "test/**/*.purs" ] +, sources = [ "src/**/*.purs", "test/**/*.purs", "example/**/*.purs" ] , backend = "purs-backend-es build" } From 77cef33cae33dff4bdffac39256dbe2463287b39 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 13:20:15 +0100 Subject: [PATCH 04/26] Updated installed packages --- example/Util/BMA.purs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 35a318abb..5d2942803 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -21,4 +21,13 @@ vlenN = toNumber <<< vlen mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) \ No newline at end of file +mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) + +newtype Matrix a = Array (Array a) + +matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a +matIndex mat row col = case mat !! row of + Nothing -> Nothing + Just arr -> arr !! col + +genMat :: Int -> Int -> Matrix (Int × Int) From ee3c59460fd98d7b28dbc3db48fc7a101fa01200 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 14:04:54 +0100 Subject: [PATCH 05/26] First round of matrix utils --- example/Util/BMA.purs | 59 +++++++++++++++++++++++++++++++++++++++++-- package.json | 3 +++ spago.dhall | 2 +- 3 files changed, 61 insertions(+), 3 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 5d2942803..97685e5ce 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,10 +2,17 @@ module Example.Util.BMA where import Prelude +import Data.Array (cons, head, mapMaybe, range, tail, uncons, (!!)) import Data.FastVect.FastVect (Vect) import Data.Foldable (foldl) import Data.Int (toNumber) +import Data.Maybe (Maybe(..)) import Data.Number (pow) +import Data.Ord (abs) +import Effect (Effect) +import Effect.Class.Console (log) +import Effect.Console (logShow) +import Util (type (×), (×)) product :: forall a len. Semiring a => Vect len a -> a product v = foldl (*) one v @@ -23,11 +30,59 @@ mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) -newtype Matrix a = Array (Array a) +type Matrix a = Array (Array a) + +data IntInf = IInt Int | Infty +instance Show IntInf where + show (IInt x) = "IInt" <> show x + show (Infty) = "Infty" + matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a matIndex mat row col = case mat !! row of Nothing -> Nothing Just arr -> arr !! col -genMat :: Int -> Int -> Matrix (Int × Int) +matOfInds :: Int -> Int -> Matrix (Int × Int) +matOfInds nrows ncols = matrix + where + rowInds = range 1 nrows + zipRow :: forall a. a -> Int -> Array (a × Int) + zipRow datum num = map (\x -> datum × x) (range 1 num) + matrix = map (\x -> zipRow x ncols) rowInds + +genMat :: forall a. (Int × Int -> a) -> Int -> Int -> Matrix a +genMat f nrows ncols = f' matrix + where + f' = map (\row -> map (\x -> f x) row) + matrix = matOfInds nrows ncols + +mapIndMat ∷ ∀ (f71 ∷ Type -> Type) (f74 ∷ Type -> Type) (a75 ∷ Type) (b76 ∷ Type). Functor f71 ⇒ Functor f74 ⇒ (a75 → b76) → f71 (f74 a75) → f71 (f74 b76) +mapIndMat f = map (\y -> map (\x -> f x) y) + +bandMatrix :: Matrix (Int × Int) -> Int -> Matrix IntInf +bandMatrix indexMat slack = mapIndMat withinBand indexMat + where + withinBand :: (Int × Int) -> IntInf + withinBand (x × y) = if (abs $ x - y) <= slack then IInt 1 else Infty + +transpose :: forall a. Array (Array a) -> Array (Array a) +transpose xs = + case uncons xs of + Nothing -> + xs + Just { head: h, tail: xss } -> + case uncons h of + Nothing -> + transpose xss + Just { head: x, tail: xs' } -> + (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) + + +main :: Effect Unit +main = do + logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) + let newMat = (genMat (\(x × y) -> x + y) 3 4) + log $ "newMat: " <> (show newMat) + log $ "transposed: " <> (show (transpose newMat)) + diff --git a/package.json b/package.json index 3183adc66..55a843767 100644 --- a/package.json +++ b/package.json @@ -4,6 +4,9 @@ "test-all": "rm -rf output && yarn build-tests && yarn tests && yarn build-app-tests && yarn app-tests", "clean-app": "rm -rf dist/app && mkdir -p dist/app && cp -r fluid dist/app && cp web/index.html dist/app && cp -r web/css dist/app && cp -r web/pdf dist/app", "build-app": "yarn clean-app && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main App.Main --to dist/app/app.js", + "clean-ex" : "rm -rf dist/ex && mkdir -p dist/ex && cp -r fluid dist/ex && cp web/index.html dist/ex && cp -r web/css dist/ex", + "build-ex" : "yarn clean-ex && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Example.Util.BMA --to dist/ex/app.js", + "example": "npx http-serve dist/ex -a 127.0.0.1", "serve-app": "yarn build-app && npx http-serve dist/app -a 127.0.0.1 -c-1", "clean-tests": "rm -rf dist/tests && mkdir -p dist/tests && cp web/tests.html dist/tests", "clean-bench": "rm -rf dist/benches && mkdir -p dist/benches && cp -r fluid dist/benches && cp web/index.html dist/benches && cp -r web/css dist/benches", diff --git a/spago.dhall b/spago.dhall index 9cb2c46e8..5cabf820a 100644 --- a/spago.dhall +++ b/spago.dhall @@ -46,6 +46,6 @@ You can edit this file as you like. , "web-events" ] , packages = ./packages.dhall -, sources = [ "src/**/*.purs", "test/**/*.purs" ] +, sources = [ "src/**/*.purs", "test/**/*.purs", "example/**/*.purs" ] , backend = "purs-backend-es build" } From c1c94abfd014a3a89f3e61fbbaed1e7ded6db924 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 15:17:25 +0100 Subject: [PATCH 06/26] Sorted more matrix utilities for completing the LSA problem --- example/Util/BMA.purs | 66 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 61 insertions(+), 5 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 97685e5ce..4a5416e79 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,12 +2,13 @@ module Example.Util.BMA where import Prelude -import Data.Array (cons, head, mapMaybe, range, tail, uncons, (!!)) +import Data.Array (cons, head, mapMaybe, range, tail, uncons, zip, zipWith, (!!)) import Data.FastVect.FastVect (Vect) -import Data.Foldable (foldl) +import Data.Foldable (class Foldable, foldl) import Data.Int (toNumber) import Data.Maybe (Maybe(..)) import Data.Number (pow) +import Data.Int (pow) as I import Data.Ord (abs) import Effect (Effect) import Effect.Class.Console (log) @@ -17,8 +18,11 @@ import Util (type (×), (×)) product :: forall a len. Semiring a => Vect len a -> a product v = foldl (*) one v -sum :: forall a len. Semiring a => Vect len a -> a -sum v = foldl (+) zero v +vsum :: forall a len. Semiring a => Vect len a -> a +vsum v = foldl (+) zero v + +sum :: forall f a. Foldable f => Semiring a => f a -> a +sum xs = foldl (+) zero xs vlen :: forall a len. Vect len a -> Int vlen xs = foldl (\count _x -> (+) 1 count) 0 xs @@ -28,7 +32,7 @@ vlenN = toNumber <<< vlen mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) +mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0/p) type Matrix a = Array (Array a) @@ -37,6 +41,36 @@ instance Show IntInf where show (IInt x) = "IInt" <> show x show (Infty) = "Infty" +instance Semiring IntInf where + add Infty _ = Infty + add _ Infty = Infty + add (IInt x) (IInt y) = IInt (x + y) + zero = IInt 0 + one = IInt 1 + mul Infty _ = Infty + mul _ Infty = Infty + mul (IInt x) (IInt y) = IInt (x * y) +instance Ring IntInf where -- seems potentially dangerous? + sub Infty _ = Infty + sub _ Infty = Infty + sub (IInt x) (IInt y) = IInt (x - y) + +instance Eq IntInf where + eq Infty Infty = true + eq Infty (IInt _) = false + eq (IInt _) Infty = false + eq (IInt x) (IInt y) = eq x y + +instance Ord IntInf where + compare Infty Infty = EQ + compare Infty (IInt _) = GT + compare (IInt _) Infty = LT + compare (IInt x) (IInt y) = compare x y + +ipow :: IntInf -> IntInf -> IntInf +ipow Infty _ = Infty +ipow _ Infty = Infty +ipow (IInt x) (IInt y) = IInt (x `I.pow` y) matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a matIndex mat row col = case mat !! row of @@ -78,6 +112,23 @@ transpose xs = Just { head: x, tail: xs' } -> (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) +mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mMult x y = do + ar <- x + bc <- (transpose y) + pure $ [(sum $ zipWith (*) ar bc)] + +mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) + +mSub :: forall a. Ring a => Matrix a -> Matrix a -> Matrix a +mSub x y = map (\(xR × yR) -> zipWith (-) xR yR) (zip x y) + +mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b +mapMatrix f m = map (\row -> map f row) m + +matSquared :: Matrix IntInf -> Matrix IntInf +matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat main :: Effect Unit main = do @@ -86,3 +137,8 @@ main = do log $ "newMat: " <> (show newMat) log $ "transposed: " <> (show (transpose newMat)) + let testMul = [[1, 2],[3, 4]] `mMult` [[5, 6], [7, 8]] + logShow testMul + let testAdd = [[1,0], [0, 1]] `mSub` [[0, 1], [1,0]] + logShow testAdd + From 708b2bc95a006e5cd0ba9d1c8de98136dedcab06 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 16:23:44 +0100 Subject: [PATCH 07/26] Nonnegative row/columns --- example/Util/BMA.purs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 4a5416e79..4a6b32453 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -130,6 +130,15 @@ mapMatrix f m = map (\row -> map f row) m matSquared :: Matrix IntInf -> Matrix IntInf matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat +nonnegRows :: Matrix IntInf -> Matrix IntInf +nonnegRows mat = map normedRow mat + where + rowMin arr = foldl min Infty arr + normedRow arr = let y = rowMin arr in map (\x -> x - y) arr + +nonnegColumns :: Matrix IntInf -> Matrix IntInf +nonnegColumns = transpose <<< nonnegRows <<< transpose + main :: Effect Unit main = do logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) @@ -141,4 +150,8 @@ main = do logShow testMul let testAdd = [[1,0], [0, 1]] `mSub` [[0, 1], [1,0]] logShow testAdd + let testnonnegRows = nonnegRows [[IInt 1, IInt 2, IInt 3], + [IInt 2, IInt 3, IInt 4], + [IInt 3, IInt 4, IInt 5]] + logShow testnonnegRows From d052bd42023a4c3a3fd0eebc06a592a502ca0866 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 17:27:25 +0100 Subject: [PATCH 08/26] interrim commit so can push --- example/Util/BMA.purs | 49 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 46 insertions(+), 3 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 4a6b32453..839fda011 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,18 +2,19 @@ module Example.Util.BMA where import Prelude -import Data.Array (cons, head, mapMaybe, range, tail, uncons, zip, zipWith, (!!)) +import Data.Array (cons, head, length, mapMaybe, range, sort, tail, uncons, zip, zipWith, (!!), (..)) import Data.FastVect.FastVect (Vect) import Data.Foldable (class Foldable, foldl) +import Data.Int (pow) as I import Data.Int (toNumber) import Data.Maybe (Maybe(..)) import Data.Number (pow) -import Data.Int (pow) as I import Data.Ord (abs) +import Data.Tuple (snd) import Effect (Effect) import Effect.Class.Console (log) import Effect.Console (logShow) -import Util (type (×), (×)) +import Util (type (×), error, (×)) product :: forall a len. Semiring a => Vect len a -> a product v = foldl (*) one v @@ -130,6 +131,19 @@ mapMatrix f m = map (\row -> map f row) m matSquared :: Matrix IntInf -> Matrix IntInf matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat +mergeUnion :: Array Int -> Array Int -> Array Int +mergeUnion xxs yys = + case uncons xxs of + Nothing -> yys + Just {head: x, tail: xs} -> + case uncons yys of + Nothing -> xxs + Just {head: y, tail: ys} -> + case compare x y of + LT -> x `cons` mergeUnion xs yys + EQ -> x `cons` mergeUnion xs ys + GT -> y `cons` mergeUnion xxs ys + nonnegRows :: Matrix IntInf -> Matrix IntInf nonnegRows mat = map normedRow mat where @@ -139,6 +153,35 @@ nonnegRows mat = map normedRow mat nonnegColumns :: Matrix IntInf -> Matrix IntInf nonnegColumns = transpose <<< nonnegRows <<< transpose +-- unsure what the point of this is +complement :: Int -> Array Int -> Array Int +complement n arr = worker 1 arr + where + worker :: Int -> Array Int -> Array Int + worker k xxs = if k > n then [] + else + case uncons xxs of + Nothing -> k..n + Just {head: x, tail: xs} -> + case compare k x of + EQ -> worker (k+1) xs + LT -> k `cons` worker (k+1) xxs + GT -> worker k xs + +step3 :: Int -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) +step3 dim starred coveredRows coveredCols matrix = + let colsC = mergeUnion coveredCols (sort $ map snd starred) in + if length colsC == (length matrix) then starred + else + step4 dim starred coveredRows coveredCols matrix + +step4 dim starred coveredRows coveredCols matrix = + let rowsNC = complement dim coveredRows + colsNC = complement dim coveredCols + f :: Int × Int -> IntInf + f ij = error "todo" + in + error "todo" main :: Effect Unit main = do logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) From 14da51a499d60ef3eb81e9d0234530d22ae344dd Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Thu, 21 Sep 2023 17:31:14 +0100 Subject: [PATCH 09/26] Added an interim comment --- example/Util/BMA.purs | 1 + 1 file changed, 1 insertion(+) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 839fda011..2d557be87 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -175,6 +175,7 @@ step3 dim starred coveredRows coveredCols matrix = else step4 dim starred coveredRows coveredCols matrix +-- Unsure what this is going to do in reference implementation step4 dim starred coveredRows coveredCols matrix = let rowsNC = complement dim coveredRows colsNC = complement dim coveredCols From a40ec5e645b929a35dfd7e604f001c67d9617e70 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Fri, 22 Sep 2023 09:49:05 +0100 Subject: [PATCH 10/26] More utilities and steps added to the example --- example/Util/BMA.purs | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 2d557be87..75aefb16c 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,7 +2,7 @@ module Example.Util.BMA where import Prelude -import Data.Array (cons, head, length, mapMaybe, range, sort, tail, uncons, zip, zipWith, (!!), (..)) +import Data.Array (concatMap, cons, head, length, mapMaybe, range, sort, tail, uncons, zip, zipWith, (!!), (..)) import Data.FastVect.FastVect (Vect) import Data.Foldable (class Foldable, foldl) import Data.Int (pow) as I @@ -35,6 +35,15 @@ mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0/p) +firstJust :: forall a. Array (Maybe a) -> Maybe a +firstJust aas = + case uncons aas of + Nothing -> Nothing + Just {head: a, tail: as} -> + case a of + Nothing -> firstJust as + Just _ -> a + type Matrix a = Array (Array a) data IntInf = IInt Int | Infty @@ -113,6 +122,13 @@ transpose xs = Just { head: x, tail: xs' } -> (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) + +arrayProduct :: forall a b. Array a -> Array b -> Array (a × b) +arrayProduct arr1 arr2 = concatMap (\y -> pairify y arr2) arr1 + where + pairify :: a -> Array b -> Array (a × b) + pairify elem arr = map (\x -> elem × x) arr + mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a mMult x y = do ar <- x @@ -179,8 +195,11 @@ step3 dim starred coveredRows coveredCols matrix = step4 dim starred coveredRows coveredCols matrix = let rowsNC = complement dim coveredRows colsNC = complement dim coveredCols - f :: Int × Int -> IntInf - f ij = error "todo" + f :: Int × Int -> Maybe (Int × Int) + f (i × j) = + case matIndex matrix i j of + Nothing -> Nothing + Just iinf -> if iinf == IInt 0 then Just (i × j) else Nothing in error "todo" main :: Effect Unit From 5a78a4dea36645a04fc381635af003c6ff83c94a Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Fri, 22 Sep 2023 10:20:58 +0100 Subject: [PATCH 11/26] Nearly finished step 4, need to fix some weird type error --- example/Util/BMA.purs | 42 +++++++++++++++++++++++++++++++++--------- 1 file changed, 33 insertions(+), 9 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 75aefb16c..15496a763 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,14 +2,16 @@ module Example.Util.BMA where import Prelude -import Data.Array (concatMap, cons, head, length, mapMaybe, range, sort, tail, uncons, zip, zipWith, (!!), (..)) +import Data.Array (concat, concatMap, cons, drop, head, insert, length, mapMaybe, range, sort, tail, take, uncons, zip, zipWith, (!!), (..)) import Data.FastVect.FastVect (Vect) -import Data.Foldable (class Foldable, foldl) +import Data.Foldable (class Foldable, find, foldl) +import Data.FoldableWithIndex (findWithIndex) import Data.Int (pow) as I import Data.Int (toNumber) import Data.Maybe (Maybe(..)) import Data.Number (pow) import Data.Ord (abs) +import Data.Traversable (for) import Data.Tuple (snd) import Effect (Effect) import Effect.Class.Console (log) @@ -163,9 +165,11 @@ mergeUnion xxs yys = nonnegRows :: Matrix IntInf -> Matrix IntInf nonnegRows mat = map normedRow mat where - rowMin arr = foldl min Infty arr normedRow arr = let y = rowMin arr in map (\x -> x - y) arr +rowMin :: Array IntInf -> IntInf +rowMin arr = foldl min Infty arr + nonnegColumns :: Matrix IntInf -> Matrix IntInf nonnegColumns = transpose <<< nonnegRows <<< transpose @@ -184,15 +188,15 @@ complement n arr = worker 1 arr LT -> k `cons` worker (k+1) xxs GT -> worker k xs -step3 :: Int -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) -step3 dim starred coveredRows coveredCols matrix = +step3 :: Int -> Array (Int × Int) -> Array (Int × Int) ->Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) +step3 dim starred primed coveredRows coveredCols matrix = let colsC = mergeUnion coveredCols (sort $ map snd starred) in if length colsC == (length matrix) then starred else - step4 dim starred coveredRows coveredCols matrix + step4 dim starred primed coveredRows coveredCols matrix -- Unsure what this is going to do in reference implementation -step4 dim starred coveredRows coveredCols matrix = +step4 dim starred primed coveredRows coveredCols matrix = let rowsNC = complement dim coveredRows colsNC = complement dim coveredCols f :: Int × Int -> Maybe (Int × Int) @@ -200,8 +204,28 @@ step4 dim starred coveredRows coveredCols matrix = case matIndex matrix i j of Nothing -> Nothing Just iinf -> if iinf == IInt 0 then Just (i × j) else Nothing - in - error "todo" + uncovered = arrayProduct rowsNC colsNC + mp = firstJust (map f uncovered) + in + case mp of + Nothing -> let es = for uncovered (\(x × y) -> matIndex matrix x y) in + case es of + Just es' -> step6 (rowMin es') + Nothing -> error "Not sure how I got here" + Just ij@(i × _) -> let newPrim = cons ij primed in + case find (\(p × _) -> p == i) starred of + Nothing -> step5 ij + Just (_ × q) -> step4 dim starred (insert i coveredRows) (remove q coveredCols) + +remove :: forall a. Eq a => a -> Array a -> Array a +remove elem arr = + case findWithIndex (\_ x -> x == elem) arr of + Nothing -> arr + Just {index: ind, value: _} -> + concat [(take ind arr), (drop (ind + 1) arr)] + +step5 = error "todo" +step6 = error "todo" main :: Effect Unit main = do logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) From a6be3205f731eb2eb3543f8b184df1b69d655302 Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Fri, 22 Sep 2023 10:34:14 +0100 Subject: [PATCH 12/26] Fixed type error via giving an explicit type to the erroring function --- example/Util/BMA.purs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 15496a763..f81a6f1ad 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -196,6 +196,7 @@ step3 dim starred primed coveredRows coveredCols matrix = step4 dim starred primed coveredRows coveredCols matrix -- Unsure what this is going to do in reference implementation +step4 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) step4 dim starred primed coveredRows coveredCols matrix = let rowsNC = complement dim coveredRows colsNC = complement dim coveredCols @@ -215,7 +216,7 @@ step4 dim starred primed coveredRows coveredCols matrix = Just ij@(i × _) -> let newPrim = cons ij primed in case find (\(p × _) -> p == i) starred of Nothing -> step5 ij - Just (_ × q) -> step4 dim starred (insert i coveredRows) (remove q coveredCols) + Just (_ × q) -> step4 dim starred newPrim (insert i coveredRows) (remove q coveredCols) matrix remove :: forall a. Eq a => a -> Array a -> Array a remove elem arr = From e22cd270a783ee0addcccf1073c9f0f43f34bfaf Mon Sep 17 00:00:00 2001 From: Joe Bond Date: Fri, 22 Sep 2023 11:19:53 +0100 Subject: [PATCH 13/26] interrim commit --- example/Util/BMA.purs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index f81a6f1ad..95643fd58 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -175,7 +175,7 @@ nonnegColumns = transpose <<< nonnegRows <<< transpose -- unsure what the point of this is complement :: Int -> Array Int -> Array Int -complement n arr = worker 1 arr + complement n arr = worker 1 arr where worker :: Int -> Array Int -> Array Int worker k xxs = if k > n then [] @@ -188,7 +188,7 @@ complement n arr = worker 1 arr LT -> k `cons` worker (k+1) xxs GT -> worker k xs -step3 :: Int -> Array (Int × Int) -> Array (Int × Int) ->Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) +step3 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) step3 dim starred primed coveredRows coveredCols matrix = let colsC = mergeUnion coveredCols (sort $ map snd starred) in if length colsC == (length matrix) then starred @@ -225,7 +225,8 @@ remove elem arr = Just {index: ind, value: _} -> concat [(take ind arr), (drop (ind + 1) arr)] -step5 = error "todo" +step5 dim starred primed coveredRows coveredCols matrix += error "todo" step6 = error "todo" main :: Effect Unit main = do From bc8a4c1bc99d41086a331198ce4ba17e831a583d Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 27 Sep 2023 09:55:43 +0100 Subject: [PATCH 14/26] interrim commit --- example/Util/BMA.purs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 95643fd58..4659633d2 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -175,7 +175,7 @@ nonnegColumns = transpose <<< nonnegRows <<< transpose -- unsure what the point of this is complement :: Int -> Array Int -> Array Int - complement n arr = worker 1 arr +complement n arr = worker 1 arr where worker :: Int -> Array Int -> Array Int worker k xxs = if k > n then [] @@ -215,7 +215,7 @@ step4 dim starred primed coveredRows coveredCols matrix = Nothing -> error "Not sure how I got here" Just ij@(i × _) -> let newPrim = cons ij primed in case find (\(p × _) -> p == i) starred of - Nothing -> step5 ij + Nothing -> step5 ij dim starred primed coveredRows coveredCols matrix Just (_ × q) -> step4 dim starred newPrim (insert i coveredRows) (remove q coveredCols) matrix remove :: forall a. Eq a => a -> Array a -> Array a @@ -225,8 +225,8 @@ remove elem arr = Just {index: ind, value: _} -> concat [(take ind arr), (drop (ind + 1) arr)] -step5 dim starred primed coveredRows coveredCols matrix -= error "todo" +step5 ij dim starred primed coveredRows coveredCols matrix = error "todo" + step6 = error "todo" main :: Effect Unit main = do From 2c79d58717a4b8724b7bc8d2c5ca6aaa88ccbd8a Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 27 Sep 2023 11:20:48 +0100 Subject: [PATCH 15/26] First implementation of DTW, needs revisions but seems reasonable --- example/Util/BMA.purs | 9 ++++++--- example/Util/DTW.purs | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 3 deletions(-) create mode 100644 example/Util/DTW.purs diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 4659633d2..5fba9b20d 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -106,11 +106,14 @@ genMat f nrows ncols = f' matrix mapIndMat ∷ ∀ (f71 ∷ Type -> Type) (f74 ∷ Type -> Type) (a75 ∷ Type) (b76 ∷ Type). Functor f71 ⇒ Functor f74 ⇒ (a75 → b76) → f71 (f74 a75) → f71 (f74 b76) mapIndMat f = map (\y -> map (\x -> f x) y) -bandMatrix :: Matrix (Int × Int) -> Int -> Matrix IntInf -bandMatrix indexMat slack = mapIndMat withinBand indexMat +bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf +bandMatrix' indexMat slack = mapIndMat withinBand indexMat where withinBand :: (Int × Int) -> IntInf - withinBand (x × y) = if (abs $ x - y) <= slack then IInt 1 else Infty + withinBand (x × y) = if (abs $ x - y) <= slack then IInt 0 else Infty + +bandMatrix :: Int -> Int -> Int -> Matrix IntInf +bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window transpose :: forall a. Array (Array a) -> Array (Array a) transpose xs = diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs new file mode 100644 index 000000000..aad066b16 --- /dev/null +++ b/example/Util/DTW.purs @@ -0,0 +1,36 @@ +module Example.Util.DTW where + +import Prelude + +import Data.Array (concat, concatMap, drop, foldl, length, mapWithIndex, range, replicate, sort, take, unsafeIndex, zip) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Traversable (for) +import Example.Util.BMA (IntInf(..), Matrix(..), bandMatrix, genMat, matIndex) +import Util (type (×), error, (×)) + +distanceDTW :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf +distanceDTW seq1 seq2 window cost = + let init = bandMatrix (length seq1) (length seq2) window + mappedIndices = sort (concatMap (\i -> indexIndices i (range (max 1 (i - window)) (min (length seq2) (i + window)))) (range 1 (length seq1))) + in + foldl worker init mappedIndices + where + worker :: Matrix IntInf -> (Int × Int) -> Matrix IntInf + worker matrix (i × j) = + let im1j = indexInfty (i-1) j matrix + ijm1 = indexInfty i (j-1) matrix + im1jm1 = indexInfty (i-1) (j-1) matrix + minim = min im1jm1 $ min im1j ijm1 + costij = (cost (unsafeIndex seq1 i) (unsafeIndex seq2 j)) + minim + in + updateAt i j matrix (\_ -> costij) + +updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a +updateAt i j matrix f = case matIndex matrix i j of + Nothing -> matrix + Just x -> concat [take (i-1) matrix,[ mapWithIndex (\ind x -> if ind == j then f x else x ) (unsafeIndex matrix i)], drop i matrix] +indexInfty :: Int -> Int -> Matrix IntInf -> IntInf +indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) +indexIndices :: Int -> Array Int -> Array (Int × Int) +indexIndices i js = zip (replicate (length js) i) js + From 61e671941380798cb13163492d5836c6e7a49a64 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 27 Sep 2023 11:30:29 +0100 Subject: [PATCH 16/26] Changed entry point for examples, built test example --- example/Example.purs | 13 ++++++++----- example/Util/BMA.purs | 2 +- example/Util/DTW.purs | 8 +++++--- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index 3aa7f41b8..a5d4f9929 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -1,12 +1,15 @@ module Example.Example where import Prelude + import Effect (Effect) import Effect.Class.Console (logShow) -import Example.Util.BMA (mean) -import Data.FastVect.FastVect ((:), empty) +import Example.Util.BMA (IntInf(..)) +import Example.Util.DTW (distEuclid, distanceDTW) -main :: Effect Unit +main :: Partial => Effect Unit main = do - logShow "100" - logShow (mean 2.0 (1.0:2.0:3.0:4.0:5.0:6.0:7.0:8.0:9.0:10.0: empty)) \ No newline at end of file + let x = [IInt 3, IInt 1, IInt 2, IInt 2, IInt 1] + y = [IInt 2, IInt 0, IInt 0, IInt 3, IInt 3, IInt 1, IInt 0] + dtwMat = distanceDTW x y 1 distEuclid + logShow dtwMat diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 5fba9b20d..bc9a27a53 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -246,4 +246,4 @@ main = do [IInt 2, IInt 3, IInt 4], [IInt 3, IInt 4, IInt 5]] logShow testnonnegRows - + diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index aad066b16..aed48f71f 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -4,9 +4,9 @@ import Prelude import Data.Array (concat, concatMap, drop, foldl, length, mapWithIndex, range, replicate, sort, take, unsafeIndex, zip) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Traversable (for) -import Example.Util.BMA (IntInf(..), Matrix(..), bandMatrix, genMat, matIndex) -import Util (type (×), error, (×)) +import Data.Ord (abs) +import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex) +import Util (type (×), (×)) distanceDTW :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf distanceDTW seq1 seq2 window cost = @@ -34,3 +34,5 @@ indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) indexIndices :: Int -> Array Int -> Array (Int × Int) indexIndices i js = zip (replicate (length js) i) js +distEuclid :: IntInf -> IntInf -> IntInf +distEuclid x y = abs $ x - y \ No newline at end of file From 5b132901ee8140634e9c459e37d0f79b7b206ea0 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 27 Sep 2023 11:30:44 +0100 Subject: [PATCH 17/26] Committed changed example entrypoint --- package.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.json b/package.json index 3004f708e..480964d70 100644 --- a/package.json +++ b/package.json @@ -5,7 +5,7 @@ "clean-app": "rm -rf dist/app && mkdir -p dist/app && cp -r fluid dist/app && cp web/index.html dist/app && cp -r web/css dist/app && cp -r web/pdf dist/app", "build-app": "yarn clean-app && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main App.Main --to dist/app/app.js", "clean-ex" : "rm -rf dist/ex && mkdir -p dist/ex && cp -r fluid dist/ex && cp web/index.html dist/ex && cp -r web/css dist/ex", - "build-ex" : "yarn clean-ex && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Example.Util.BMA --to dist/ex/app.js", + "build-ex" : "yarn clean-ex && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Example.Example --to dist/ex/app.js", "example": "npx http-serve dist/ex -a 127.0.0.1", "serve-app": "yarn build-app && npx http-serve dist/app -a 127.0.0.1 -c-1", "clean-tests": "rm -rf dist/tests && mkdir -p dist/tests && cp web/tests.html dist/tests", From 0f356ac213f2a046ee80e1881e7a500e92a07d42 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Wed, 27 Sep 2023 15:07:48 +0100 Subject: [PATCH 18/26] Computation of DTW cost matrix complete, about to extract optimal path --- example/Example.purs | 17 +++++++++------ example/Util/BMA.purs | 8 ++++---- example/Util/DTW.purs | 48 ++++++++++++++++++++++++++++--------------- 3 files changed, 46 insertions(+), 27 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index a5d4f9929..d72fc8343 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -3,13 +3,18 @@ module Example.Example where import Prelude import Effect (Effect) -import Effect.Class.Console (logShow) +import Effect.Class.Console (log, logShow) import Example.Util.BMA (IntInf(..)) -import Example.Util.DTW (distEuclid, distanceDTW) - -main :: Partial => Effect Unit +import Example.Util.DTW (distEuclid, distanceDTWWindow) +import Partial.Unsafe (unsafePartial) +import Util ((×)) +main :: Effect Unit main = do + log "Beginning DTW!" + logShow $ distEuclid (IInt 4) (IInt 2) + logShow $ min (IInt 4) Infty let x = [IInt 3, IInt 1, IInt 2, IInt 2, IInt 1] y = [IInt 2, IInt 0, IInt 0, IInt 3, IInt 3, IInt 1, IInt 0] - dtwMat = distanceDTW x y 1 distEuclid - logShow dtwMat + m1 × m2 = unsafePartial $ distanceDTWWindow x y 7 distEuclid + logShow m2 + logShow m1 diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index bc9a27a53..c18211cf0 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -92,9 +92,9 @@ matIndex mat row col = case mat !! row of matOfInds :: Int -> Int -> Matrix (Int × Int) matOfInds nrows ncols = matrix where - rowInds = range 1 nrows + rowInds = range 0 nrows zipRow :: forall a. a -> Int -> Array (a × Int) - zipRow datum num = map (\x -> datum × x) (range 1 num) + zipRow datum num = map (\x -> datum × x) (range 0 num) matrix = map (\x -> zipRow x ncols) rowInds genMat :: forall a. (Int × Int -> a) -> Int -> Int -> Matrix a @@ -110,7 +110,7 @@ bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf bandMatrix' indexMat slack = mapIndMat withinBand indexMat where withinBand :: (Int × Int) -> IntInf - withinBand (x × y) = if (abs $ x - y) <= slack then IInt 0 else Infty + withinBand (x × y) = if ((x /= 0) && (y /=0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty bandMatrix :: Int -> Int -> Int -> Matrix IntInf bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window @@ -246,4 +246,4 @@ main = do [IInt 2, IInt 3, IInt 4], [IInt 3, IInt 4, IInt 5]] logShow testnonnegRows - + diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index aed48f71f..d41d76c5a 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -2,37 +2,51 @@ module Example.Util.DTW where import Prelude -import Data.Array (concat, concatMap, drop, foldl, length, mapWithIndex, range, replicate, sort, take, unsafeIndex, zip) +import Data.Array (concat, elemIndex, foldl, length, modifyAtIndices, range, replicate, sort, unsafeIndex, zip) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Ord (abs) import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex) -import Util (type (×), (×)) +import Util (type (×), (×), error) -distanceDTW :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf -distanceDTW seq1 seq2 window cost = - let init = bandMatrix (length seq1) (length seq2) window - mappedIndices = sort (concatMap (\i -> indexIndices i (range (max 1 (i - window)) (min (length seq2) (i + window)))) (range 1 (length seq1))) +distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (Matrix IntInf) +distanceDTWWindow seq1 seq2 window cost = + let n = length seq1 + m = length seq2 + init = bandMatrix n m window + mappedIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) in - foldl worker init mappedIndices + foldl worker init mappedIndices × init where worker :: Matrix IntInf -> (Int × Int) -> Matrix IntInf - worker matrix (i × j) = - let im1j = indexInfty (i-1) j matrix - ijm1 = indexInfty i (j-1) matrix - im1jm1 = indexInfty (i-1) (j-1) matrix - minim = min im1jm1 $ min im1j ijm1 - costij = (cost (unsafeIndex seq1 i) (unsafeIndex seq2 j)) + minim + worker matrix (i' × j') = + let + im1j = indexInfty (i'-1) j' matrix + ijm1 = indexInfty i' (j'-1) matrix + im1jm1 = indexInfty (i'-1) (j'-1) matrix + minim × _prev = prevDirection (i' × j') im1j ijm1 im1jm1 + costij = (cost (unsafeIndex seq1 (i'-1)) (unsafeIndex seq2 (j'-1))) + minim in - updateAt i j matrix (\_ -> costij) + updateAt i' j' matrix (\_ -> costij) + +prevDirection :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) +prevDirection (i × j) im1j ijm1 im1jm1 = + let minimal = min im1j $ min ijm1 im1jm1 + ind = elemIndex minimal [im1j, ijm1, im1jm1] + in + case ind of + Nothing -> error "error, cannot occur" + Just y -> if y == 0 then (im1j × ((i-1)×j)) + else if y == 1 then (ijm1 × (i×(j-1))) + else if y == 2 then (im1jm1 × ((i-1)×(j-1))) + else error "cannot occur" updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a updateAt i j matrix f = case matIndex matrix i j of Nothing -> matrix - Just x -> concat [take (i-1) matrix,[ mapWithIndex (\ind x -> if ind == j then f x else x ) (unsafeIndex matrix i)], drop i matrix] + Just _ -> modifyAtIndices [i] (\row -> modifyAtIndices [j] f row) matrix indexInfty :: Int -> Int -> Matrix IntInf -> IntInf indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) indexIndices :: Int -> Array Int -> Array (Int × Int) indexIndices i js = zip (replicate (length js) i) js distEuclid :: IntInf -> IntInf -> IntInf -distEuclid x y = abs $ x - y \ No newline at end of file +distEuclid x y = (x - y) * (x - y) \ No newline at end of file From 79bba502842fe4548d271b334bc8e6e69f9c5e69 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Thu, 28 Sep 2023 09:55:18 +0100 Subject: [PATCH 19/26] Added unsafe indexing for matrices, for use in optimal path extraction --- example/Util/DTW.purs | 42 +++++++++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index d41d76c5a..f34dd83f0 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -3,29 +3,31 @@ module Example.Util.DTW where import Prelude import Data.Array (concat, elemIndex, foldl, length, modifyAtIndices, range, replicate, sort, unsafeIndex, zip) +import Data.List (List(..)) import Data.Maybe (Maybe(..), fromMaybe) -import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex) +import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex, matOfInds) +import Partial.Unsafe (unsafePartial) import Util (type (×), (×), error) -distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (Matrix IntInf) +distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (Matrix (Int × Int)) distanceDTWWindow seq1 seq2 window cost = let n = length seq1 m = length seq2 init = bandMatrix n m window mappedIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) in - foldl worker init mappedIndices × init + foldl worker (init × (matOfInds n m)) mappedIndices where - worker :: Matrix IntInf -> (Int × Int) -> Matrix IntInf - worker matrix (i' × j') = + worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) + worker (dists × inds) (i' × j') = let - im1j = indexInfty (i'-1) j' matrix - ijm1 = indexInfty i' (j'-1) matrix - im1jm1 = indexInfty (i'-1) (j'-1) matrix - minim × _prev = prevDirection (i' × j') im1j ijm1 im1jm1 + im1j = indexInfty (i'-1) j' dists + ijm1 = indexInfty i' (j'-1) dists + im1jm1 = indexInfty (i'-1) (j'-1) dists + minim × prev = prevDirection (i' × j') im1j ijm1 im1jm1 costij = (cost (unsafeIndex seq1 (i'-1)) (unsafeIndex seq2 (j'-1))) + minim in - updateAt i' j' matrix (\_ -> costij) + (updateAt i' j' dists (\_ -> costij)) × (updateAt i' j' inds (\_ -> prev)) prevDirection :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) prevDirection (i × j) im1j ijm1 im1jm1 = @@ -39,6 +41,21 @@ prevDirection (i × j) im1j ijm1 im1jm1 = else if y == 2 then (im1jm1 × ((i-1)×(j-1))) else error "cannot occur" +extractPath :: Matrix (Int × Int) -> List (Int × Int) +extractPath matrix = + let i = length matrix + j = length (unsafePartial $ unsafeIndex matrix 1) + in + traverser i j matrix Nil + where + traverser :: Int -> Int -> Matrix (Int × Int) -> List (Int × Int) -> List (Int × Int) + traverser x y mat accum = + if x == y && y == 0 then + accum + else + let newPath = Cons (x × y) accum + (nextX × nextY) = unsafeMatrixInd x y mat + in traverser nextX nextY mat newPath updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a updateAt i j matrix f = case matIndex matrix i j of Nothing -> matrix @@ -49,4 +66,7 @@ indexIndices :: Int -> Array Int -> Array (Int × Int) indexIndices i js = zip (replicate (length js) i) js distEuclid :: IntInf -> IntInf -> IntInf -distEuclid x y = (x - y) * (x - y) \ No newline at end of file +distEuclid x y = (x - y) * (x - y) + +unsafeMatrixInd :: forall a. Int -> Int -> Matrix a -> a +unsafeMatrixInd x y mat = unsafePartial $ if x < length mat then let xRow = unsafeIndex mat x in if y < length xRow then unsafeIndex xRow y else error "index out of bounds" else error "index out of bounds" \ No newline at end of file From 2a8246fc55e16437b8cbf92990c1d1cf4b8178bc Mon Sep 17 00:00:00 2001 From: JosephBond Date: Thu, 28 Sep 2023 10:17:26 +0100 Subject: [PATCH 20/26] First pass over implementation of dynamic time warping --- example/Util/DTW.purs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index f34dd83f0..91c6fb392 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -9,14 +9,15 @@ import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex, matOfInds) import Partial.Unsafe (unsafePartial) import Util (type (×), (×), error) -distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (Matrix (Int × Int)) +distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (List (Int × Int)) distanceDTWWindow seq1 seq2 window cost = let n = length seq1 m = length seq2 init = bandMatrix n m window mappedIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) + (result × priorcells) = foldl worker (init × (matOfInds n m)) mappedIndices in - foldl worker (init × (matOfInds n m)) mappedIndices + result × (extractPath priorcells) where worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) worker (dists × inds) (i' × j') = @@ -43,8 +44,8 @@ prevDirection (i × j) im1j ijm1 im1jm1 = extractPath :: Matrix (Int × Int) -> List (Int × Int) extractPath matrix = - let i = length matrix - j = length (unsafePartial $ unsafeIndex matrix 1) + let i = length matrix - 1 + j = length (unsafePartial $ unsafeIndex matrix 1) - 1 in traverser i j matrix Nil where From 82c3a196d3ae7f12561ddfd0476fbd7c5229a28b Mon Sep 17 00:00:00 2001 From: JosephBond Date: Thu, 28 Sep 2023 12:44:57 +0100 Subject: [PATCH 21/26] Changed script for tidying, began cleanup pass on the DTW code --- example/Example.purs | 18 +++--- example/Util/BMA.purs | 145 +++++++++++++++++++++++------------------- example/Util/DTW.purs | 110 ++++++++++++++++++-------------- package.json | 2 +- 4 files changed, 154 insertions(+), 121 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index d72fc8343..2960e75c4 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -8,13 +8,15 @@ import Example.Util.BMA (IntInf(..)) import Example.Util.DTW (distEuclid, distanceDTWWindow) import Partial.Unsafe (unsafePartial) import Util ((×)) + main :: Effect Unit main = do - log "Beginning DTW!" - logShow $ distEuclid (IInt 4) (IInt 2) - logShow $ min (IInt 4) Infty - let x = [IInt 3, IInt 1, IInt 2, IInt 2, IInt 1] - y = [IInt 2, IInt 0, IInt 0, IInt 3, IInt 3, IInt 1, IInt 0] - m1 × m2 = unsafePartial $ distanceDTWWindow x y 7 distEuclid - logShow m2 - logShow m1 + log "Beginning DTW!" + logShow $ distEuclid (IInt 4) (IInt 2) + logShow $ min (IInt 4) Infty + let + x = [ IInt 3, IInt 1, IInt 2, IInt 2, IInt 1 ] + y = [ IInt 2, IInt 0, IInt 0, IInt 3, IInt 3, IInt 1, IInt 0 ] + m1 × m2 = unsafePartial $ distanceDTWWindow x y 7 distEuclid + logShow m2 + logShow m1 diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index c18211cf0..30ebab7ed 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -19,7 +19,7 @@ import Effect.Console (logShow) import Util (type (×), error, (×)) product :: forall a len. Semiring a => Vect len a -> a -product v = foldl (*) one v +product v = foldl (*) one v vsum :: forall a len. Semiring a => Vect len a -> a vsum v = foldl (+) zero v @@ -35,20 +35,21 @@ vlenN = toNumber <<< vlen mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0/p) +mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0 / p) firstJust :: forall a. Array (Maybe a) -> Maybe a -firstJust aas = +firstJust aas = case uncons aas of - Nothing -> Nothing - Just {head: a, tail: as} -> - case a of - Nothing -> firstJust as - Just _ -> a + Nothing -> Nothing + Just { head: a, tail: as } -> + case a of + Nothing -> firstJust as + Just _ -> a type Matrix a = Array (Array a) data IntInf = IInt Int | Infty + instance Show IntInf where show (IInt x) = "IInt" <> show x show (Infty) = "Infty" @@ -62,6 +63,7 @@ instance Semiring IntInf where mul Infty _ = Infty mul _ Infty = Infty mul (IInt x) (IInt y) = IInt (x * y) + instance Ring IntInf where -- seems potentially dangerous? sub Infty _ = Infty sub _ Infty = Infty @@ -86,13 +88,14 @@ ipow (IInt x) (IInt y) = IInt (x `I.pow` y) matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a matIndex mat row col = case mat !! row of - Nothing -> Nothing - Just arr -> arr !! col + Nothing -> Nothing + Just arr -> arr !! col matOfInds :: Int -> Int -> Matrix (Int × Int) matOfInds nrows ncols = matrix where rowInds = range 0 nrows + zipRow :: forall a. a -> Int -> Array (a × Int) zipRow datum num = map (\x -> datum × x) (range 0 num) matrix = map (\x -> zipRow x ncols) rowInds @@ -107,38 +110,37 @@ mapIndMat ∷ ∀ (f71 ∷ Type -> Type) (f74 ∷ Type -> Type) (a75 ∷ Type) ( mapIndMat f = map (\y -> map (\x -> f x) y) bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf -bandMatrix' indexMat slack = mapIndMat withinBand indexMat +bandMatrix' indexMat slack = mapIndMat withinBand indexMat where withinBand :: (Int × Int) -> IntInf - withinBand (x × y) = if ((x /= 0) && (y /=0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty + withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty bandMatrix :: Int -> Int -> Int -> Matrix IntInf bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window transpose :: forall a. Array (Array a) -> Array (Array a) transpose xs = - case uncons xs of - Nothing -> - xs - Just { head: h, tail: xss } -> - case uncons h of - Nothing -> - transpose xss - Just { head: x, tail: xs' } -> - (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) - + case uncons xs of + Nothing -> + xs + Just { head: h, tail: xss } -> + case uncons h of + Nothing -> + transpose xss + Just { head: x, tail: xs' } -> + (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) arrayProduct :: forall a b. Array a -> Array b -> Array (a × b) arrayProduct arr1 arr2 = concatMap (\y -> pairify y arr2) arr1 where - pairify :: a -> Array b -> Array (a × b) - pairify elem arr = map (\x -> elem × x) arr - + pairify :: a -> Array b -> Array (a × b) + pairify elem arr = map (\x -> elem × x) arr + mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a mMult x y = do ar <- x bc <- (transpose y) - pure $ [(sum $ zipWith (*) ar bc)] + pure $ [ (sum $ zipWith (*) ar bc) ] mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) @@ -153,13 +155,13 @@ matSquared :: Matrix IntInf -> Matrix IntInf matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat mergeUnion :: Array Int -> Array Int -> Array Int -mergeUnion xxs yys = +mergeUnion xxs yys = case uncons xxs of Nothing -> yys - Just {head: x, tail: xs} -> + Just { head: x, tail: xs } -> case uncons yys of Nothing -> xxs - Just {head: y, tail: ys} -> + Just { head: y, tail: ys } -> case compare x y of LT -> x `cons` mergeUnion xs yys EQ -> x `cons` mergeUnion xs ys @@ -181,56 +183,68 @@ complement :: Int -> Array Int -> Array Int complement n arr = worker 1 arr where worker :: Int -> Array Int -> Array Int - worker k xxs = if k > n then [] - else - case uncons xxs of - Nothing -> k..n - Just {head: x, tail: xs} -> - case compare k x of - EQ -> worker (k+1) xs - LT -> k `cons` worker (k+1) xxs - GT -> worker k xs + worker k xxs = + if k > n then [] + else + case uncons xxs of + Nothing -> k .. n + Just { head: x, tail: xs } -> + case compare k x of + EQ -> worker (k + 1) xs + LT -> k `cons` worker (k + 1) xxs + GT -> worker k xs step3 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) -step3 dim starred primed coveredRows coveredCols matrix = - let colsC = mergeUnion coveredCols (sort $ map snd starred) in - if length colsC == (length matrix) then starred +step3 dim starred primed coveredRows coveredCols matrix = + let + colsC = mergeUnion coveredCols (sort $ map snd starred) + in + if length colsC == (length matrix) then starred else step4 dim starred primed coveredRows coveredCols matrix -- Unsure what this is going to do in reference implementation step4 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) -step4 dim starred primed coveredRows coveredCols matrix = - let rowsNC = complement dim coveredRows - colsNC = complement dim coveredCols - f :: Int × Int -> Maybe (Int × Int) - f (i × j) = +step4 dim starred primed coveredRows coveredCols matrix = + let + rowsNC = complement dim coveredRows + colsNC = complement dim coveredCols + + f :: Int × Int -> Maybe (Int × Int) + f (i × j) = case matIndex matrix i j of Nothing -> Nothing Just iinf -> if iinf == IInt 0 then Just (i × j) else Nothing - uncovered = arrayProduct rowsNC colsNC - mp = firstJust (map f uncovered) + uncovered = arrayProduct rowsNC colsNC + mp = firstJust (map f uncovered) in case mp of - Nothing -> let es = for uncovered (\(x × y) -> matIndex matrix x y) in - case es of - Just es' -> step6 (rowMin es') - Nothing -> error "Not sure how I got here" - Just ij@(i × _) -> let newPrim = cons ij primed in - case find (\(p × _) -> p == i) starred of - Nothing -> step5 ij dim starred primed coveredRows coveredCols matrix - Just (_ × q) -> step4 dim starred newPrim (insert i coveredRows) (remove q coveredCols) matrix + Nothing -> + let + es = for uncovered (\(x × y) -> matIndex matrix x y) + in + case es of + Just es' -> step6 (rowMin es') + Nothing -> error "Not sure how I got here" + Just ij@(i × _) -> + let + newPrim = cons ij primed + in + case find (\(p × _) -> p == i) starred of + Nothing -> step5 ij dim starred primed coveredRows coveredCols matrix + Just (_ × q) -> step4 dim starred newPrim (insert i coveredRows) (remove q coveredCols) matrix remove :: forall a. Eq a => a -> Array a -> Array a -remove elem arr = +remove elem arr = case findWithIndex (\_ x -> x == elem) arr of Nothing -> arr - Just {index: ind, value: _} -> - concat [(take ind arr), (drop (ind + 1) arr)] + Just { index: ind, value: _ } -> + concat [ (take ind arr), (drop (ind + 1) arr) ] step5 ij dim starred primed coveredRows coveredCols matrix = error "todo" step6 = error "todo" + main :: Effect Unit main = do logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) @@ -238,12 +252,15 @@ main = do log $ "newMat: " <> (show newMat) log $ "transposed: " <> (show (transpose newMat)) - let testMul = [[1, 2],[3, 4]] `mMult` [[5, 6], [7, 8]] + let testMul = [ [ 1, 2 ], [ 3, 4 ] ] `mMult` [ [ 5, 6 ], [ 7, 8 ] ] logShow testMul - let testAdd = [[1,0], [0, 1]] `mSub` [[0, 1], [1,0]] + let testAdd = [ [ 1, 0 ], [ 0, 1 ] ] `mSub` [ [ 0, 1 ], [ 1, 0 ] ] logShow testAdd - let testnonnegRows = nonnegRows [[IInt 1, IInt 2, IInt 3], - [IInt 2, IInt 3, IInt 4], - [IInt 3, IInt 4, IInt 5]] + let + testnonnegRows = nonnegRows + [ [ IInt 1, IInt 2, IInt 3 ] + , [ IInt 2, IInt 3, IInt 4 ] + , [ IInt 3, IInt 4, IInt 5 ] + ] logShow testnonnegRows diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index 91c6fb392..9304b530b 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -10,64 +10,78 @@ import Partial.Unsafe (unsafePartial) import Util (type (×), (×), error) distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (List (Int × Int)) -distanceDTWWindow seq1 seq2 window cost = - let n = length seq1 - m = length seq2 - init = bandMatrix n m window - mappedIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) - (result × priorcells) = foldl worker (init × (matOfInds n m)) mappedIndices - in - result × (extractPath priorcells) - where - worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) - worker (dists × inds) (i' × j') = - let - im1j = indexInfty (i'-1) j' dists - ijm1 = indexInfty i' (j'-1) dists - im1jm1 = indexInfty (i'-1) (j'-1) dists - minim × prev = prevDirection (i' × j') im1j ijm1 im1jm1 - costij = (cost (unsafeIndex seq1 (i'-1)) (unsafeIndex seq2 (j'-1))) + minim - in - (updateAt i' j' dists (\_ -> costij)) × (updateAt i' j' inds (\_ -> prev)) +distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) + where + n = length seq1 + m = length seq2 + init = bandMatrix n m window + nextIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) + + worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) + worker (dists × inds) (i' × j') = + let + im1j = indexInfty (i' - 1) j' dists + ijm1 = indexInfty i' (j' - 1) dists + im1jm1 = indexInfty (i' - 1) (j' - 1) dists + minim × prev = prevDirection (i' × j') im1j ijm1 im1jm1 + costij = (cost (unsafeIndex seq1 (i' - 1)) (unsafeIndex seq2 (j' - 1))) + minim + in + (updateAt i' j' dists (\_ -> costij)) × (updateAt i' j' inds (\_ -> prev)) + + (result × priorcells) = foldl worker (init × (matOfInds n m)) nextIndices prevDirection :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) -prevDirection (i × j) im1j ijm1 im1jm1 = - let minimal = min im1j $ min ijm1 im1jm1 - ind = elemIndex minimal [im1j, ijm1, im1jm1] - in - case ind of - Nothing -> error "error, cannot occur" - Just y -> if y == 0 then (im1j × ((i-1)×j)) - else if y == 1 then (ijm1 × (i×(j-1))) - else if y == 2 then (im1jm1 × ((i-1)×(j-1))) - else error "cannot occur" +prevDirection (i × j) im1j ijm1 im1jm1 = + let + minimal = min im1j $ min ijm1 im1jm1 + ind = elemIndex minimal [ im1j, ijm1, im1jm1 ] + in + case ind of + Nothing -> error "error, cannot occur" + Just y -> + if y == 0 then (im1j × ((i - 1) × j)) + else if y == 1 then (ijm1 × (i × (j - 1))) + else if y == 2 then (im1jm1 × ((i - 1) × (j - 1))) + else error "cannot occur" extractPath :: Matrix (Int × Int) -> List (Int × Int) -extractPath matrix = - let i = length matrix - 1 - j = length (unsafePartial $ unsafeIndex matrix 1) - 1 - in - traverser i j matrix Nil - where - traverser :: Int -> Int -> Matrix (Int × Int) -> List (Int × Int) -> List (Int × Int) - traverser x y mat accum = - if x == y && y == 0 then - accum - else - let newPath = Cons (x × y) accum - (nextX × nextY) = unsafeMatrixInd x y mat - in traverser nextX nextY mat newPath -updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a +extractPath matrix = traverser i j matrix Nil + where + i = length matrix - 1 + j = length (unsafePartial $ unsafeIndex matrix 1) - 1 + + traverser :: Int -> Int -> Matrix (Int × Int) -> List (Int × Int) -> List (Int × Int) + traverser x y mat accum = + if x == y && y == 0 then + accum + else + traverser nextX nextY mat newPath + where + newPath = Cons (x × y) accum + (nextX × nextY) = unsafeMatrixInd x y mat + +updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a updateAt i j matrix f = case matIndex matrix i j of - Nothing -> matrix - Just _ -> modifyAtIndices [i] (\row -> modifyAtIndices [j] f row) matrix + Nothing -> matrix + Just _ -> modifyAtIndices [ i ] (\row -> modifyAtIndices [ j ] f row) matrix + indexInfty :: Int -> Int -> Matrix IntInf -> IntInf indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) + indexIndices :: Int -> Array Int -> Array (Int × Int) indexIndices i js = zip (replicate (length js) i) js distEuclid :: IntInf -> IntInf -> IntInf -distEuclid x y = (x - y) * (x - y) +distEuclid x y = (x - y) * (x - y) unsafeMatrixInd :: forall a. Int -> Int -> Matrix a -> a -unsafeMatrixInd x y mat = unsafePartial $ if x < length mat then let xRow = unsafeIndex mat x in if y < length xRow then unsafeIndex xRow y else error "index out of bounds" else error "index out of bounds" \ No newline at end of file +unsafeMatrixInd x y mat = unsafePartial $ + if x < length mat then + let + xRow = unsafeIndex mat x + in + if y < length xRow then + unsafeIndex xRow y + else + error "index out of bounds" + else error "index out of bounds" \ No newline at end of file diff --git a/package.json b/package.json index 480964d70..051336e43 100644 --- a/package.json +++ b/package.json @@ -22,7 +22,7 @@ "build-app-tests": "yarn clean-app-tests && spago build --purs-args '--strict --censor-codes=UserDefinedWarning' && purs-backend-es bundle-app --main Test.App.Main --to dist/app-tests/app.js", "app-tests": "karma start karma.conf.app-tests.js", "app-tests-browser": "karma start karma.conf.app-tests.js --browsers=Chrome --singleRun=false", - "tidy": "yarn purs-tidy format-in-place src/*.purs src/App/**/*.purs src/**/*.purs test/*.purs test/**/*.purs" + "tidy": "yarn purs-tidy format-in-place src/*.purs src/App/**/*.purs src/**/*.purs test/*.purs test/**/*.purs example/**/*.purs example/*.purs" }, "dependencies": { "@codemirror/commands": "6.2.2", From 124ba8c278b736665c617bc6522ff10ed3d6abb3 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Thu, 28 Sep 2023 13:20:48 +0100 Subject: [PATCH 22/26] Replaced BMA with DTW --- example/Util/BMA.purs | 266 ------------------------------------------ example/Util/DTW.purs | 213 +++++++++++++++++++++++++++++++-- 2 files changed, 204 insertions(+), 275 deletions(-) delete mode 100644 example/Util/BMA.purs diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs deleted file mode 100644 index 30ebab7ed..000000000 --- a/example/Util/BMA.purs +++ /dev/null @@ -1,266 +0,0 @@ -module Example.Util.BMA where - -import Prelude - -import Data.Array (concat, concatMap, cons, drop, head, insert, length, mapMaybe, range, sort, tail, take, uncons, zip, zipWith, (!!), (..)) -import Data.FastVect.FastVect (Vect) -import Data.Foldable (class Foldable, find, foldl) -import Data.FoldableWithIndex (findWithIndex) -import Data.Int (pow) as I -import Data.Int (toNumber) -import Data.Maybe (Maybe(..)) -import Data.Number (pow) -import Data.Ord (abs) -import Data.Traversable (for) -import Data.Tuple (snd) -import Effect (Effect) -import Effect.Class.Console (log) -import Effect.Console (logShow) -import Util (type (×), error, (×)) - -product :: forall a len. Semiring a => Vect len a -> a -product v = foldl (*) one v - -vsum :: forall a len. Semiring a => Vect len a -> a -vsum v = foldl (+) zero v - -sum :: forall f a. Foldable f => Semiring a => f a -> a -sum xs = foldl (+) zero xs - -vlen :: forall a len. Vect len a -> Int -vlen xs = foldl (\count _x -> (+) 1 count) 0 xs - -vlenN :: forall a len. Vect len a -> Number -vlenN = toNumber <<< vlen - -mean :: forall len. Number -> Vect len Number -> Number -mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0 / p) - -firstJust :: forall a. Array (Maybe a) -> Maybe a -firstJust aas = - case uncons aas of - Nothing -> Nothing - Just { head: a, tail: as } -> - case a of - Nothing -> firstJust as - Just _ -> a - -type Matrix a = Array (Array a) - -data IntInf = IInt Int | Infty - -instance Show IntInf where - show (IInt x) = "IInt" <> show x - show (Infty) = "Infty" - -instance Semiring IntInf where - add Infty _ = Infty - add _ Infty = Infty - add (IInt x) (IInt y) = IInt (x + y) - zero = IInt 0 - one = IInt 1 - mul Infty _ = Infty - mul _ Infty = Infty - mul (IInt x) (IInt y) = IInt (x * y) - -instance Ring IntInf where -- seems potentially dangerous? - sub Infty _ = Infty - sub _ Infty = Infty - sub (IInt x) (IInt y) = IInt (x - y) - -instance Eq IntInf where - eq Infty Infty = true - eq Infty (IInt _) = false - eq (IInt _) Infty = false - eq (IInt x) (IInt y) = eq x y - -instance Ord IntInf where - compare Infty Infty = EQ - compare Infty (IInt _) = GT - compare (IInt _) Infty = LT - compare (IInt x) (IInt y) = compare x y - -ipow :: IntInf -> IntInf -> IntInf -ipow Infty _ = Infty -ipow _ Infty = Infty -ipow (IInt x) (IInt y) = IInt (x `I.pow` y) - -matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a -matIndex mat row col = case mat !! row of - Nothing -> Nothing - Just arr -> arr !! col - -matOfInds :: Int -> Int -> Matrix (Int × Int) -matOfInds nrows ncols = matrix - where - rowInds = range 0 nrows - - zipRow :: forall a. a -> Int -> Array (a × Int) - zipRow datum num = map (\x -> datum × x) (range 0 num) - matrix = map (\x -> zipRow x ncols) rowInds - -genMat :: forall a. (Int × Int -> a) -> Int -> Int -> Matrix a -genMat f nrows ncols = f' matrix - where - f' = map (\row -> map (\x -> f x) row) - matrix = matOfInds nrows ncols - -mapIndMat ∷ ∀ (f71 ∷ Type -> Type) (f74 ∷ Type -> Type) (a75 ∷ Type) (b76 ∷ Type). Functor f71 ⇒ Functor f74 ⇒ (a75 → b76) → f71 (f74 a75) → f71 (f74 b76) -mapIndMat f = map (\y -> map (\x -> f x) y) - -bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf -bandMatrix' indexMat slack = mapIndMat withinBand indexMat - where - withinBand :: (Int × Int) -> IntInf - withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty - -bandMatrix :: Int -> Int -> Int -> Matrix IntInf -bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window - -transpose :: forall a. Array (Array a) -> Array (Array a) -transpose xs = - case uncons xs of - Nothing -> - xs - Just { head: h, tail: xss } -> - case uncons h of - Nothing -> - transpose xss - Just { head: x, tail: xs' } -> - (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) - -arrayProduct :: forall a b. Array a -> Array b -> Array (a × b) -arrayProduct arr1 arr2 = concatMap (\y -> pairify y arr2) arr1 - where - pairify :: a -> Array b -> Array (a × b) - pairify elem arr = map (\x -> elem × x) arr - -mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a -mMult x y = do - ar <- x - bc <- (transpose y) - pure $ [ (sum $ zipWith (*) ar bc) ] - -mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a -mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) - -mSub :: forall a. Ring a => Matrix a -> Matrix a -> Matrix a -mSub x y = map (\(xR × yR) -> zipWith (-) xR yR) (zip x y) - -mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b -mapMatrix f m = map (\row -> map f row) m - -matSquared :: Matrix IntInf -> Matrix IntInf -matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat - -mergeUnion :: Array Int -> Array Int -> Array Int -mergeUnion xxs yys = - case uncons xxs of - Nothing -> yys - Just { head: x, tail: xs } -> - case uncons yys of - Nothing -> xxs - Just { head: y, tail: ys } -> - case compare x y of - LT -> x `cons` mergeUnion xs yys - EQ -> x `cons` mergeUnion xs ys - GT -> y `cons` mergeUnion xxs ys - -nonnegRows :: Matrix IntInf -> Matrix IntInf -nonnegRows mat = map normedRow mat - where - normedRow arr = let y = rowMin arr in map (\x -> x - y) arr - -rowMin :: Array IntInf -> IntInf -rowMin arr = foldl min Infty arr - -nonnegColumns :: Matrix IntInf -> Matrix IntInf -nonnegColumns = transpose <<< nonnegRows <<< transpose - --- unsure what the point of this is -complement :: Int -> Array Int -> Array Int -complement n arr = worker 1 arr - where - worker :: Int -> Array Int -> Array Int - worker k xxs = - if k > n then [] - else - case uncons xxs of - Nothing -> k .. n - Just { head: x, tail: xs } -> - case compare k x of - EQ -> worker (k + 1) xs - LT -> k `cons` worker (k + 1) xxs - GT -> worker k xs - -step3 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) -step3 dim starred primed coveredRows coveredCols matrix = - let - colsC = mergeUnion coveredCols (sort $ map snd starred) - in - if length colsC == (length matrix) then starred - else - step4 dim starred primed coveredRows coveredCols matrix - --- Unsure what this is going to do in reference implementation -step4 :: Int -> Array (Int × Int) -> Array (Int × Int) -> Array Int -> Array Int -> Matrix IntInf -> Array (Int × Int) -step4 dim starred primed coveredRows coveredCols matrix = - let - rowsNC = complement dim coveredRows - colsNC = complement dim coveredCols - - f :: Int × Int -> Maybe (Int × Int) - f (i × j) = - case matIndex matrix i j of - Nothing -> Nothing - Just iinf -> if iinf == IInt 0 then Just (i × j) else Nothing - uncovered = arrayProduct rowsNC colsNC - mp = firstJust (map f uncovered) - in - case mp of - Nothing -> - let - es = for uncovered (\(x × y) -> matIndex matrix x y) - in - case es of - Just es' -> step6 (rowMin es') - Nothing -> error "Not sure how I got here" - Just ij@(i × _) -> - let - newPrim = cons ij primed - in - case find (\(p × _) -> p == i) starred of - Nothing -> step5 ij dim starred primed coveredRows coveredCols matrix - Just (_ × q) -> step4 dim starred newPrim (insert i coveredRows) (remove q coveredCols) matrix - -remove :: forall a. Eq a => a -> Array a -> Array a -remove elem arr = - case findWithIndex (\_ x -> x == elem) arr of - Nothing -> arr - Just { index: ind, value: _ } -> - concat [ (take ind arr), (drop (ind + 1) arr) ] - -step5 ij dim starred primed coveredRows coveredCols matrix = error "todo" - -step6 = error "todo" - -main :: Effect Unit -main = do - logShow (genMat (\(x × y) -> if (abs $ x - y) <= 3 then IInt 1 else Infty) 10 10) - let newMat = (genMat (\(x × y) -> x + y) 3 4) - log $ "newMat: " <> (show newMat) - log $ "transposed: " <> (show (transpose newMat)) - - let testMul = [ [ 1, 2 ], [ 3, 4 ] ] `mMult` [ [ 5, 6 ], [ 7, 8 ] ] - logShow testMul - let testAdd = [ [ 1, 0 ], [ 0, 1 ] ] `mSub` [ [ 0, 1 ], [ 1, 0 ] ] - logShow testAdd - let - testnonnegRows = nonnegRows - [ [ IInt 1, IInt 2, IInt 3 ] - , [ IInt 2, IInt 3, IInt 4 ] - , [ IInt 3, IInt 4, IInt 5 ] - ] - logShow testnonnegRows - diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index 9304b530b..816506dcd 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -2,12 +2,207 @@ module Example.Util.DTW where import Prelude -import Data.Array (concat, elemIndex, foldl, length, modifyAtIndices, range, replicate, sort, unsafeIndex, zip) +import Data.Array (concat, concatMap, cons, drop, elemIndex, head, length, mapMaybe, modifyAtIndices, range, replicate, sort, tail, take, uncons, unsafeIndex, zip, zipWith, (!!), (..)) +import Data.FastVect.FastVect (Vect) +import Data.Foldable (class Foldable, foldl) +import Data.FoldableWithIndex (findWithIndex) +import Data.Int (pow) as I +import Data.Int (toNumber) import Data.List (List(..)) import Data.Maybe (Maybe(..), fromMaybe) -import Example.Util.BMA (IntInf(..), Matrix, bandMatrix, matIndex, matOfInds) +import Data.Number (pow) +import Data.Ord (abs) +import Effect (Effect) +import Effect.Class.Console (log) +import Effect.Console (logShow) import Partial.Unsafe (unsafePartial) -import Util (type (×), (×), error) +import Util (type (×), error, (×)) + +product :: forall a len. Semiring a => Vect len a -> a +product v = foldl (*) one v + +vsum :: forall a len. Semiring a => Vect len a -> a +vsum v = foldl (+) zero v + +sum :: forall f a. Foldable f => Semiring a => f a -> a +sum xs = foldl (+) zero xs + +vlen :: forall a len. Vect len a -> Int +vlen xs = foldl (\count _x -> (+) 1 count) 0 xs + +vlenN :: forall a len. Vect len a -> Number +vlenN = toNumber <<< vlen + +mean :: forall len. Number -> Vect len Number -> Number +mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) +mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0 / p) + +firstJust :: forall a. Array (Maybe a) -> Maybe a +firstJust aas = + case uncons aas of + Nothing -> Nothing + Just { head: a, tail: as } -> + case a of + Nothing -> firstJust as + Just _ -> a + +type Matrix a = Array (Array a) + +data IntInf = IInt Int | Infty + +instance Show IntInf where + show (IInt x) = "IInt" <> show x + show (Infty) = "Infty" + +instance Semiring IntInf where + add Infty _ = Infty + add _ Infty = Infty + add (IInt x) (IInt y) = IInt (x + y) + zero = IInt 0 + one = IInt 1 + mul Infty _ = Infty + mul _ Infty = Infty + mul (IInt x) (IInt y) = IInt (x * y) + +instance Ring IntInf where -- seems potentially dangerous? + sub Infty _ = Infty + sub _ Infty = Infty + sub (IInt x) (IInt y) = IInt (x - y) + +instance Eq IntInf where + eq Infty Infty = true + eq Infty (IInt _) = false + eq (IInt _) Infty = false + eq (IInt x) (IInt y) = eq x y + +instance Ord IntInf where + compare Infty Infty = EQ + compare Infty (IInt _) = GT + compare (IInt _) Infty = LT + compare (IInt x) (IInt y) = compare x y + +ipow :: IntInf -> IntInf -> IntInf +ipow Infty _ = Infty +ipow _ Infty = Infty +ipow (IInt x) (IInt y) = IInt (x `I.pow` y) + +matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a +matIndex mat row col = case mat !! row of + Nothing -> Nothing + Just arr -> arr !! col + +matOfInds :: Int -> Int -> Matrix (Int × Int) +matOfInds nrows ncols = matrix + where + rowInds = range 0 nrows + + zipRow :: forall a. a -> Int -> Array (a × Int) + zipRow datum num = map (\x -> datum × x) (range 0 num) + matrix = map (\x -> zipRow x ncols) rowInds + +genMat :: forall a. (Int × Int -> a) -> Int -> Int -> Matrix a +genMat f nrows ncols = f' matrix + where + f' = map (\row -> map (\x -> f x) row) + matrix = matOfInds nrows ncols + +mapIndMat ∷ forall a b. (a -> b) -> Matrix a -> Matrix b +mapIndMat f = map (\y -> map (\x -> f x) y) + +bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf +bandMatrix' indexMat slack = mapIndMat withinBand indexMat + where + withinBand :: (Int × Int) -> IntInf + withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty + +bandMatrix :: Int -> Int -> Int -> Matrix IntInf +bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window + +transpose :: forall a. Array (Array a) -> Array (Array a) +transpose xs = + case uncons xs of + Nothing -> + xs + Just { head: h, tail: xss } -> + case uncons h of + Nothing -> + transpose xss + Just { head: x, tail: xs' } -> + (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) + +arrayProduct :: forall a b. Array a -> Array b -> Array (a × b) +arrayProduct arr1 arr2 = concatMap (\y -> pairify y arr2) arr1 + where + pairify :: a -> Array b -> Array (a × b) + pairify elem arr = map (\x -> elem × x) arr + +mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mMult x y = do + ar <- x + bc <- (transpose y) + pure $ [ (sum $ zipWith (*) ar bc) ] + +mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) + +mSub :: forall a. Ring a => Matrix a -> Matrix a -> Matrix a +mSub x y = map (\(xR × yR) -> zipWith (-) xR yR) (zip x y) + +mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b +mapMatrix f m = map (\row -> map f row) m + +matSquared :: Matrix IntInf -> Matrix IntInf +matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat + +mergeUnion :: Array Int -> Array Int -> Array Int +mergeUnion xxs yys = + case uncons xxs of + Nothing -> yys + Just { head: x, tail: xs } -> + case uncons yys of + Nothing -> xxs + Just { head: y, tail: ys } -> + case compare x y of + LT -> x `cons` mergeUnion xs yys + EQ -> x `cons` mergeUnion xs ys + GT -> y `cons` mergeUnion xxs ys + +nonnegRows :: Matrix IntInf -> Matrix IntInf +nonnegRows mat = map normedRow mat + where + normedRow arr = let y = rowMin arr in map (\x -> x - y) arr + +rowMin :: Array IntInf -> IntInf +rowMin arr = foldl min Infty arr + +nonnegColumns :: Matrix IntInf -> Matrix IntInf +nonnegColumns = transpose <<< nonnegRows <<< transpose + +-- unsure what the point of this is +complement :: Int -> Array Int -> Array Int +complement n arr = worker 1 arr + where + worker :: Int -> Array Int -> Array Int + worker k xxs = + if k > n then [] + else + case uncons xxs of + Nothing -> k .. n + Just { head: x, tail: xs } -> + case compare k x of + EQ -> worker (k + 1) xs + LT -> k `cons` worker (k + 1) xxs + GT -> worker k xs + +-- Unsure what this is going to do in reference implementation + +remove :: forall a. Eq a => a -> Array a -> Array a +remove elem arr = + case findWithIndex (\_ x -> x == elem) arr of + Nothing -> arr + Just { index: ind, value: _ } -> + concat [ (take ind arr), (drop (ind + 1) arr) ] + distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (List (Int × Int)) distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) @@ -15,7 +210,7 @@ distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) n = length seq1 m = length seq2 init = bandMatrix n m window - nextIndices = sort $ concat (map (\i -> indexIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) + nextIndices = sort $ concat (map (\i -> mkRowIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) worker (dists × inds) (i' × j') = @@ -23,15 +218,15 @@ distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) im1j = indexInfty (i' - 1) j' dists ijm1 = indexInfty i' (j' - 1) dists im1jm1 = indexInfty (i' - 1) (j' - 1) dists - minim × prev = prevDirection (i' × j') im1j ijm1 im1jm1 + minim × prev = costAndPrevD (i' × j') im1j ijm1 im1jm1 costij = (cost (unsafeIndex seq1 (i' - 1)) (unsafeIndex seq2 (j' - 1))) + minim in (updateAt i' j' dists (\_ -> costij)) × (updateAt i' j' inds (\_ -> prev)) (result × priorcells) = foldl worker (init × (matOfInds n m)) nextIndices -prevDirection :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) -prevDirection (i × j) im1j ijm1 im1jm1 = +costAndPrevD :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) +costAndPrevD (i × j) im1j ijm1 im1jm1 = let minimal = min im1j $ min ijm1 im1jm1 ind = elemIndex minimal [ im1j, ijm1, im1jm1 ] @@ -68,8 +263,8 @@ updateAt i j matrix f = case matIndex matrix i j of indexInfty :: Int -> Int -> Matrix IntInf -> IntInf indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) -indexIndices :: Int -> Array Int -> Array (Int × Int) -indexIndices i js = zip (replicate (length js) i) js +mkRowIndices :: Int -> Array Int -> Array (Int × Int) +mkRowIndices i js = zip (replicate (length js) i) js distEuclid :: IntInf -> IntInf -> IntInf distEuclid x y = (x - y) * (x - y) From d5b08f3c11928823bb2ef0a15cd437416eab63b0 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Fri, 29 Sep 2023 09:02:40 +0100 Subject: [PATCH 23/26] Replaced integers with numbers --- example/Example.purs | 9 +- example/Util/DTW.purs | 307 ++++++++++++++---------------------------- 2 files changed, 102 insertions(+), 214 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index 2960e75c4..1b7481848 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -4,19 +4,16 @@ import Prelude import Effect (Effect) import Effect.Class.Console (log, logShow) -import Example.Util.BMA (IntInf(..)) -import Example.Util.DTW (distEuclid, distanceDTWWindow) +import Example.Util.DTW (NumInf(..), distEuclid, distanceDTWWindow) import Partial.Unsafe (unsafePartial) import Util ((×)) main :: Effect Unit main = do log "Beginning DTW!" - logShow $ distEuclid (IInt 4) (IInt 2) - logShow $ min (IInt 4) Infty let - x = [ IInt 3, IInt 1, IInt 2, IInt 2, IInt 1 ] - y = [ IInt 2, IInt 0, IInt 0, IInt 3, IInt 3, IInt 1, IInt 0 ] + x = [ FNum 3.0, FNum 1.0, FNum 2.0, FNum 2.0, FNum 1.0 ] + y = [ FNum 2.0, FNum 0.0, FNum 0.0, FNum 3.0, FNum 3.0, FNum 1.0, FNum 0.0 ] m1 × m2 = unsafePartial $ distanceDTWWindow x y 7 distEuclid logShow m2 logShow m1 diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index 816506dcd..74bd45d36 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -1,218 +1,41 @@ -module Example.Util.DTW where +module Example.Util.DTW + ( NumInf(..) + , distEuclid + , distanceDTWWindow + ) where import Prelude -import Data.Array (concat, concatMap, cons, drop, elemIndex, head, length, mapMaybe, modifyAtIndices, range, replicate, sort, tail, take, uncons, unsafeIndex, zip, zipWith, (!!), (..)) -import Data.FastVect.FastVect (Vect) -import Data.Foldable (class Foldable, foldl) -import Data.FoldableWithIndex (findWithIndex) -import Data.Int (pow) as I -import Data.Int (toNumber) +import Data.Array (concat, cons, elemIndex, head, length, mapMaybe, modifyAtIndices, range, replicate, sort, tail, uncons, unsafeIndex, zip, (!!)) +import Data.Foldable (foldl) import Data.List (List(..)) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Number (pow) import Data.Ord (abs) -import Effect (Effect) -import Effect.Class.Console (log) -import Effect.Console (logShow) import Partial.Unsafe (unsafePartial) import Util (type (×), error, (×)) -product :: forall a len. Semiring a => Vect len a -> a -product v = foldl (*) one v +---------------------------------------- +-- Dynamic Time Warp Core +---------------------------------------- -vsum :: forall a len. Semiring a => Vect len a -> a -vsum v = foldl (+) zero v - -sum :: forall f a. Foldable f => Semiring a => f a -> a -sum xs = foldl (+) zero xs - -vlen :: forall a len. Vect len a -> Int -vlen xs = foldl (\count _x -> (+) 1 count) 0 xs - -vlenN :: forall a len. Vect len a -> Number -vlenN = toNumber <<< vlen - -mean :: forall len. Number -> Vect len Number -> Number -mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0 / p) - -firstJust :: forall a. Array (Maybe a) -> Maybe a -firstJust aas = - case uncons aas of - Nothing -> Nothing - Just { head: a, tail: as } -> - case a of - Nothing -> firstJust as - Just _ -> a - -type Matrix a = Array (Array a) - -data IntInf = IInt Int | Infty - -instance Show IntInf where - show (IInt x) = "IInt" <> show x - show (Infty) = "Infty" - -instance Semiring IntInf where - add Infty _ = Infty - add _ Infty = Infty - add (IInt x) (IInt y) = IInt (x + y) - zero = IInt 0 - one = IInt 1 - mul Infty _ = Infty - mul _ Infty = Infty - mul (IInt x) (IInt y) = IInt (x * y) - -instance Ring IntInf where -- seems potentially dangerous? - sub Infty _ = Infty - sub _ Infty = Infty - sub (IInt x) (IInt y) = IInt (x - y) - -instance Eq IntInf where - eq Infty Infty = true - eq Infty (IInt _) = false - eq (IInt _) Infty = false - eq (IInt x) (IInt y) = eq x y - -instance Ord IntInf where - compare Infty Infty = EQ - compare Infty (IInt _) = GT - compare (IInt _) Infty = LT - compare (IInt x) (IInt y) = compare x y - -ipow :: IntInf -> IntInf -> IntInf -ipow Infty _ = Infty -ipow _ Infty = Infty -ipow (IInt x) (IInt y) = IInt (x `I.pow` y) - -matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a -matIndex mat row col = case mat !! row of - Nothing -> Nothing - Just arr -> arr !! col - -matOfInds :: Int -> Int -> Matrix (Int × Int) -matOfInds nrows ncols = matrix - where - rowInds = range 0 nrows - - zipRow :: forall a. a -> Int -> Array (a × Int) - zipRow datum num = map (\x -> datum × x) (range 0 num) - matrix = map (\x -> zipRow x ncols) rowInds - -genMat :: forall a. (Int × Int -> a) -> Int -> Int -> Matrix a -genMat f nrows ncols = f' matrix - where - f' = map (\row -> map (\x -> f x) row) - matrix = matOfInds nrows ncols - -mapIndMat ∷ forall a b. (a -> b) -> Matrix a -> Matrix b -mapIndMat f = map (\y -> map (\x -> f x) y) - -bandMatrix' :: Matrix (Int × Int) -> Int -> Matrix IntInf -bandMatrix' indexMat slack = mapIndMat withinBand indexMat - where - withinBand :: (Int × Int) -> IntInf - withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= slack then IInt 0 else Infty - -bandMatrix :: Int -> Int -> Int -> Matrix IntInf -bandMatrix rows cols window = bandMatrix' (matOfInds rows cols) window - -transpose :: forall a. Array (Array a) -> Array (Array a) -transpose xs = - case uncons xs of - Nothing -> - xs - Just { head: h, tail: xss } -> - case uncons h of - Nothing -> - transpose xss - Just { head: x, tail: xs' } -> - (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) - -arrayProduct :: forall a b. Array a -> Array b -> Array (a × b) -arrayProduct arr1 arr2 = concatMap (\y -> pairify y arr2) arr1 - where - pairify :: a -> Array b -> Array (a × b) - pairify elem arr = map (\x -> elem × x) arr - -mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a -mMult x y = do - ar <- x - bc <- (transpose y) - pure $ [ (sum $ zipWith (*) ar bc) ] - -mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a -mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) - -mSub :: forall a. Ring a => Matrix a -> Matrix a -> Matrix a -mSub x y = map (\(xR × yR) -> zipWith (-) xR yR) (zip x y) - -mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b -mapMatrix f m = map (\row -> map f row) m - -matSquared :: Matrix IntInf -> Matrix IntInf -matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat - -mergeUnion :: Array Int -> Array Int -> Array Int -mergeUnion xxs yys = - case uncons xxs of - Nothing -> yys - Just { head: x, tail: xs } -> - case uncons yys of - Nothing -> xxs - Just { head: y, tail: ys } -> - case compare x y of - LT -> x `cons` mergeUnion xs yys - EQ -> x `cons` mergeUnion xs ys - GT -> y `cons` mergeUnion xxs ys - -nonnegRows :: Matrix IntInf -> Matrix IntInf -nonnegRows mat = map normedRow mat +costMatrixInit :: Int -> Int -> Int -> Matrix NumInf +costMatrixInit rows cols window = mapMatrix withinBand indexMat where - normedRow arr = let y = rowMin arr in map (\x -> x - y) arr + indexMat = matOfInds rows cols -rowMin :: Array IntInf -> IntInf -rowMin arr = foldl min Infty arr + withinBand :: (Int × Int) -> NumInf + withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= window then FNum 0.0 else Infty -nonnegColumns :: Matrix IntInf -> Matrix IntInf -nonnegColumns = transpose <<< nonnegRows <<< transpose - --- unsure what the point of this is -complement :: Int -> Array Int -> Array Int -complement n arr = worker 1 arr - where - worker :: Int -> Array Int -> Array Int - worker k xxs = - if k > n then [] - else - case uncons xxs of - Nothing -> k .. n - Just { head: x, tail: xs } -> - case compare k x of - EQ -> worker (k + 1) xs - LT -> k `cons` worker (k + 1) xxs - GT -> worker k xs - --- Unsure what this is going to do in reference implementation - -remove :: forall a. Eq a => a -> Array a -> Array a -remove elem arr = - case findWithIndex (\_ x -> x == elem) arr of - Nothing -> arr - Just { index: ind, value: _ } -> - concat [ (take ind arr), (drop (ind + 1) arr) ] - - -distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> IntInf) -> Matrix IntInf × (List (Int × Int)) +distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> NumInf) -> Matrix NumInf × (List (Int × Int)) distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) where n = length seq1 m = length seq2 - init = bandMatrix n m window + init = costMatrixInit n m window +-- (1, 1), (1, 2), (2, 1), (2, 2), (2, 3), (3, 2), (3, 3), (3, 4) nextIndices = sort $ concat (map (\i -> mkRowIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) - worker :: Matrix IntInf × Matrix (Int × Int) -> (Int × Int) -> Matrix IntInf × Matrix (Int × Int) + worker :: Matrix NumInf × Matrix (Int × Int) -> (Int × Int) -> Matrix NumInf × Matrix (Int × Int) worker (dists × inds) (i' × j') = let im1j = indexInfty (i' - 1) j' dists @@ -225,7 +48,7 @@ distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) (result × priorcells) = foldl worker (init × (matOfInds n m)) nextIndices -costAndPrevD :: (Int × Int) -> IntInf -> IntInf -> IntInf -> IntInf × (Int × Int) +costAndPrevD :: (Int × Int) -> NumInf -> NumInf -> NumInf -> NumInf × (Int × Int) costAndPrevD (i × j) im1j ijm1 im1jm1 = let minimal = min im1j $ min ijm1 im1jm1 @@ -255,19 +78,23 @@ extractPath matrix = traverser i j matrix Nil newPath = Cons (x × y) accum (nextX × nextY) = unsafeMatrixInd x y mat -updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a -updateAt i j matrix f = case matIndex matrix i j of - Nothing -> matrix - Just _ -> modifyAtIndices [ i ] (\row -> modifyAtIndices [ j ] f row) matrix - -indexInfty :: Int -> Int -> Matrix IntInf -> IntInf +indexInfty :: Int -> Int -> Matrix NumInf -> NumInf indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) -mkRowIndices :: Int -> Array Int -> Array (Int × Int) -mkRowIndices i js = zip (replicate (length js) i) js +distEuclid :: NumInf -> NumInf -> NumInf +distEuclid (FNum x) (FNum y) = FNum ((x - y) * (x - y)) +distEuclid _ _ = error "cannot calc distance from Infinity" + +---------------------------------------- +-- Matrices and associated Utils +---------------------------------------- + +type Matrix a = Array (Array a) -distEuclid :: IntInf -> IntInf -> IntInf -distEuclid x y = (x - y) * (x - y) +matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a +matIndex mat row col = case mat !! row of + Nothing -> Nothing + Just arr -> arr !! col unsafeMatrixInd :: forall a. Int -> Int -> Matrix a -> a unsafeMatrixInd x y mat = unsafePartial $ @@ -279,4 +106,68 @@ unsafeMatrixInd x y mat = unsafePartial $ unsafeIndex xRow y else error "index out of bounds" - else error "index out of bounds" \ No newline at end of file + else error "index out of bounds" + +mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b +mapMatrix f m = map (\row -> map f row) m + +matOfInds :: Int -> Int -> Matrix (Int × Int) +matOfInds nrows ncols = matrix + where + rowInds = range 0 nrows + + zipRow :: forall a. a -> Int -> Array (a × Int) + zipRow datum num = map (\x -> datum × x) (range 0 num) + matrix = map (\x -> zipRow x ncols) rowInds + +transpose :: forall a. Array (Array a) -> Array (Array a) +transpose xs = + case uncons xs of + Nothing -> + xs + Just { head: h, tail: xss } -> + case uncons h of + Nothing -> + transpose xss + Just { head: x, tail: xs' } -> + (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) + +mkRowIndices :: Int -> Array Int -> Array (Int × Int) +mkRowIndices i js = zip (replicate (length js) i) js + +updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a +updateAt i j matrix f = case matIndex matrix i j of + -- Nothing -> matrix + Just _ -> modifyAtIndices [ i ] (\row -> modifyAtIndices [ j ] f row) matrix + +---------------------------------------- +-- Ints extended with Infinity, need ot be made into numbers not just ints +---------------------------------------- + +data NumInf = FNum Number | Infty + +instance Show NumInf where + show (FNum x) = "FNum" <> show x + show (Infty) = "Infty" + +instance Semiring NumInf where + add Infty _ = Infty + add _ Infty = Infty + add (FNum x) (FNum y) = FNum (x + y) + zero = FNum 0.0 + one = FNum 1.0 + mul Infty _ = Infty + mul _ Infty = Infty + mul (FNum x) (FNum y) = FNum (x * y) + +instance Eq NumInf where + eq Infty Infty = true + eq Infty (FNum _) = false + eq (FNum _) Infty = false + eq (FNum x) (FNum y) = eq x y + +instance Ord NumInf where + compare Infty Infty = EQ + compare Infty (FNum _) = GT + compare (FNum _) Infty = LT + compare (FNum x) (FNum y) = compare x y \ No newline at end of file From 6af43bfc90cc70aba2746317e8f3f42ab943807e Mon Sep 17 00:00:00 2001 From: JosephBond Date: Fri, 29 Sep 2023 10:46:29 +0100 Subject: [PATCH 24/26] Fixed up an array comprehension, verified things work with window --- example/Example.purs | 19 +++++++++++++++---- example/Util/DTW.purs | 21 ++++++++++----------- 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index 1b7481848..1a413d3a8 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -2,18 +2,29 @@ module Example.Example where import Prelude +import Data.Array ((..)) import Effect (Effect) import Effect.Class.Console (log, logShow) -import Example.Util.DTW (NumInf(..), distEuclid, distanceDTWWindow) +import Example.Util.DTW (distEuclid, distanceDTWWindow) import Partial.Unsafe (unsafePartial) import Util ((×)) main :: Effect Unit main = do log "Beginning DTW!" + let + n = 5 + m = 7 + window = 2 + nextIndices = do + i <- 1..n + j <- (max 1 (i - window))..(min m (i + window)) + [(i × j)] + logShow nextIndices let - x = [ FNum 3.0, FNum 1.0, FNum 2.0, FNum 2.0, FNum 1.0 ] - y = [ FNum 2.0, FNum 0.0, FNum 0.0, FNum 3.0, FNum 3.0, FNum 1.0, FNum 0.0 ] - m1 × m2 = unsafePartial $ distanceDTWWindow x y 7 distEuclid + x = [ 3.0, 1.0, 2.0, 2.0, 1.0 ] + y = [ 2.0, 0.0, 0.0, 3.0, 3.0, 1.0, 0.0 ] + m1 × m2 = unsafePartial $ distanceDTWWindow x y 2 distEuclid + log "Finished DTW" logShow m2 logShow m1 diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index 74bd45d36..e153aa819 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -6,7 +6,7 @@ module Example.Util.DTW import Prelude -import Data.Array (concat, cons, elemIndex, head, length, mapMaybe, modifyAtIndices, range, replicate, sort, tail, uncons, unsafeIndex, zip, (!!)) +import Data.Array (cons, elemIndex, head, length, mapMaybe, modifyAtIndices, range, tail, uncons, unsafeIndex, (!!), (..)) import Data.Foldable (foldl) import Data.List (List(..)) import Data.Maybe (Maybe(..), fromMaybe) @@ -32,9 +32,12 @@ distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) n = length seq1 m = length seq2 init = costMatrixInit n m window --- (1, 1), (1, 2), (2, 1), (2, 2), (2, 3), (3, 2), (3, 3), (3, 4) - nextIndices = sort $ concat (map (\i -> mkRowIndices i (range (max 1 (i - window)) (min m (i + window)))) (range 1 n)) - + + nextIndices = do + i <- 1..n + j <- (max 1 (i - window))..(min m (i + window)) + [(i × j)] + worker :: Matrix NumInf × Matrix (Int × Int) -> (Int × Int) -> Matrix NumInf × Matrix (Int × Int) worker (dists × inds) (i' × j') = let @@ -81,9 +84,8 @@ extractPath matrix = traverser i j matrix Nil indexInfty :: Int -> Int -> Matrix NumInf -> NumInf indexInfty i j matrix = fromMaybe Infty (matIndex matrix i j) -distEuclid :: NumInf -> NumInf -> NumInf -distEuclid (FNum x) (FNum y) = FNum ((x - y) * (x - y)) -distEuclid _ _ = error "cannot calc distance from Infinity" +distEuclid :: Number -> Number -> NumInf +distEuclid x y = FNum ((x - y) * (x - y)) ---------------------------------------- -- Matrices and associated Utils @@ -132,9 +134,6 @@ transpose xs = Just { head: x, tail: xs' } -> (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) -mkRowIndices :: Int -> Array Int -> Array (Int × Int) -mkRowIndices i js = zip (replicate (length js) i) js - updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a updateAt i j matrix f = case matIndex matrix i j of -- Nothing -> matrix @@ -147,7 +146,7 @@ updateAt i j matrix f = case matIndex matrix i j of data NumInf = FNum Number | Infty instance Show NumInf where - show (FNum x) = "FNum" <> show x + show (FNum x) = "FNum " <> show x show (Infty) = "Infty" instance Semiring NumInf where From 1f3f0b9bb3a02593e4742332ceaf5c8f64376fd6 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Fri, 29 Sep 2023 10:54:03 +0100 Subject: [PATCH 25/26] Removed pointless transpose implementation --- example/Example.purs | 10 +++++----- example/Util/DTW.purs | 29 ++++++++++------------------- 2 files changed, 15 insertions(+), 24 deletions(-) diff --git a/example/Example.purs b/example/Example.purs index 1a413d3a8..a8983dc4f 100644 --- a/example/Example.purs +++ b/example/Example.purs @@ -12,14 +12,14 @@ import Util ((×)) main :: Effect Unit main = do log "Beginning DTW!" - let + let n = 5 m = 7 - window = 2 + window = 2 nextIndices = do - i <- 1..n - j <- (max 1 (i - window))..(min m (i + window)) - [(i × j)] + i <- 1 .. n + j <- (max 1 (i - window)) .. (min m (i + window)) + [ (i × j) ] logShow nextIndices let x = [ 3.0, 1.0, 2.0, 2.0, 1.0 ] diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index e153aa819..903d2cbd7 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -6,7 +6,7 @@ module Example.Util.DTW import Prelude -import Data.Array (cons, elemIndex, head, length, mapMaybe, modifyAtIndices, range, tail, uncons, unsafeIndex, (!!), (..)) +import Data.Array (elemIndex, length, modifyAtIndices, range, unsafeIndex, (!!), (..)) import Data.Foldable (foldl) import Data.List (List(..)) import Data.Maybe (Maybe(..), fromMaybe) @@ -24,7 +24,10 @@ costMatrixInit rows cols window = mapMatrix withinBand indexMat indexMat = matOfInds rows cols withinBand :: (Int × Int) -> NumInf - withinBand (x × y) = if ((x /= 0) && (y /= 0) || (x == 0 && y == 0)) && (abs $ x - y) <= window then FNum 0.0 else Infty + withinBand (0 × 0) = FNum 0.0 + withinBand (0 × _) = Infty + withinBand (_ × 0) = Infty + withinBand (x × y) = if (abs $ x - y) <= window then FNum 0.0 else Infty distanceDTWWindow :: forall a. Partial => Array a -> Array a -> Int -> (a -> a -> NumInf) -> Matrix NumInf × (List (Int × Int)) distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) @@ -32,12 +35,12 @@ distanceDTWWindow seq1 seq2 window cost = result × (extractPath priorcells) n = length seq1 m = length seq2 init = costMatrixInit n m window - + nextIndices = do - i <- 1..n - j <- (max 1 (i - window))..(min m (i + window)) - [(i × j)] - + i <- 1 .. n + j <- (max 1 (i - window)) .. (min m (i + window)) + [ (i × j) ] + worker :: Matrix NumInf × Matrix (Int × Int) -> (Int × Int) -> Matrix NumInf × Matrix (Int × Int) worker (dists × inds) (i' × j') = let @@ -122,18 +125,6 @@ matOfInds nrows ncols = matrix zipRow datum num = map (\x -> datum × x) (range 0 num) matrix = map (\x -> zipRow x ncols) rowInds -transpose :: forall a. Array (Array a) -> Array (Array a) -transpose xs = - case uncons xs of - Nothing -> - xs - Just { head: h, tail: xss } -> - case uncons h of - Nothing -> - transpose xss - Just { head: x, tail: xs' } -> - (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) - updateAt :: forall a. Partial => Int -> Int -> Matrix a -> (a -> a) -> Matrix a updateAt i j matrix f = case matIndex matrix i j of -- Nothing -> matrix From cafda005cc91084400aee3c00b399f23fdb64d95 Mon Sep 17 00:00:00 2001 From: JosephBond Date: Fri, 29 Sep 2023 11:00:52 +0100 Subject: [PATCH 26/26] More minor corrections --- example/Util/DTW.purs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/example/Util/DTW.purs b/example/Util/DTW.purs index 903d2cbd7..822a908f0 100644 --- a/example/Util/DTW.purs +++ b/example/Util/DTW.purs @@ -62,11 +62,11 @@ costAndPrevD (i × j) im1j ijm1 im1jm1 = in case ind of Nothing -> error "error, cannot occur" - Just y -> - if y == 0 then (im1j × ((i - 1) × j)) - else if y == 1 then (ijm1 × (i × (j - 1))) - else if y == 2 then (im1jm1 × ((i - 1) × (j - 1))) - else error "cannot occur" + Just y -> case y of + 0 -> (im1j × ((i - 1) × j)) + 1 -> (ijm1 × (i × (j - 1))) + 2 -> (im1jm1 × ((i - 1) × (j - 1))) + _ -> error "cannot occur" extractPath :: Matrix (Int × Int) -> List (Int × Int) extractPath matrix = traverser i j matrix Nil @@ -75,11 +75,8 @@ extractPath matrix = traverser i j matrix Nil j = length (unsafePartial $ unsafeIndex matrix 1) - 1 traverser :: Int -> Int -> Matrix (Int × Int) -> List (Int × Int) -> List (Int × Int) - traverser x y mat accum = - if x == y && y == 0 then - accum - else - traverser nextX nextY mat newPath + traverser 0 0 _ accum = accum + traverser x y mat accum = traverser nextX nextY mat newPath where newPath = Cons (x × y) accum (nextX × nextY) = unsafeMatrixInd x y mat