├── .Rbuildignore ├── .gitignore ├── data ├── imageList.rda ├── landmarkArray.rda ├── landmarkList.rda ├── rasterList_lanK.rda ├── rasterList_regK.rda ├── rasterList_lanRGB.rda └── rasterList_regRGB.rda ├── inst └── extdata │ ├── BC0004.jpg │ ├── BC0049.jpg │ ├── BC0050.jpg │ ├── BC0071.jpg │ ├── BC0077.jpg │ ├── BC0077_vein10.txt │ ├── BC0077_vein11.txt │ ├── BC0077_vein9.txt │ ├── BC0077_vein4.txt │ ├── BC0077_vein5.txt │ ├── BC0077_vein7.txt │ ├── BC0077_vein3.txt │ ├── BC0077_vein6.txt │ ├── BC0077_vein1.txt │ ├── BC0077_vein2.txt │ ├── BC0004_landmarks_LFW.txt │ ├── BC0049_landmarks_LFW.txt │ ├── BC0050_landmarks_LFW.txt │ ├── BC0071_landmarks_LFW.txt │ ├── BC0077_landmarks_LFW.txt │ ├── BC0077_vein8.txt │ └── BC0077_outline.txt ├── man ├── plotRasterstackAsImage.Rd ├── imageList.Rd ├── landmarkList.Rd ├── landmarkArray.Rd ├── rasterList_lanK.Rd ├── rasterList_regK.Rd ├── setMask.Rd ├── rasterList_lanRGB.Rd ├── rasterList_regRGB.Rd ├── redRes.Rd ├── GMMImage.Rd ├── sampleLandmarks.Rd ├── sumRaster.Rd ├── sampleRGB.Rd ├── kImage.Rd ├── lanArray.Rd ├── createTarget.Rd ├── makeList.Rd ├── extdata.Rd ├── patGMM.Rd ├── kImageHSV.Rd ├── patK.Rd ├── alignReg.Rd ├── colorChecker_customGray.Rd ├── patK_HSV.Rd ├── colorChecker.Rd ├── colorChecker_half.Rd ├── maskOutline.Rd ├── alignLan.Rd ├── patRegK.Rd ├── patRegK_HSV.Rd ├── createPhenotype.Rd ├── patRegRGB.Rd ├── patRegHSV.Rd ├── patLanK.Rd ├── patLanK_HSV.Rd ├── patLanHSV.Rd ├── patArea.Rd ├── patLanRGB.Rd ├── patRegW.Rd ├── patLanW.Rd ├── patternize.Rd ├── patRDA.Rd ├── patPCA.Rd └── plotHeat.Rd ├── patternize.Rproj ├── R ├── plotRasterStackAsImage.R ├── redRes.R ├── extdata.R ├── setMask.R ├── lanArray.R ├── data.R ├── sampleRGB.R ├── sumRaster.R ├── createTarget.R ├── makeList.R ├── alignReg.R ├── createPhenotype.R ├── sampleLandmarks.R ├── patGMM.R ├── kImage.R ├── GMMImage.R ├── patternize.R ├── patK.R ├── maskOutline.R ├── patK_HSV.R └── kImageHSV.R ├── DESCRIPTION ├── NAMESPACE └── README.md /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | -------------------------------------------------------------------------------- /data/imageList.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/imageList.rda -------------------------------------------------------------------------------- /data/landmarkArray.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/landmarkArray.rda -------------------------------------------------------------------------------- /data/landmarkList.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/landmarkList.rda -------------------------------------------------------------------------------- /inst/extdata/BC0004.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/inst/extdata/BC0004.jpg -------------------------------------------------------------------------------- /inst/extdata/BC0049.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/inst/extdata/BC0049.jpg -------------------------------------------------------------------------------- /inst/extdata/BC0050.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/inst/extdata/BC0050.jpg -------------------------------------------------------------------------------- /inst/extdata/BC0071.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/inst/extdata/BC0071.jpg -------------------------------------------------------------------------------- /inst/extdata/BC0077.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/inst/extdata/BC0077.jpg -------------------------------------------------------------------------------- /data/rasterList_lanK.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/rasterList_lanK.rda -------------------------------------------------------------------------------- /data/rasterList_regK.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/rasterList_regK.rda -------------------------------------------------------------------------------- /data/rasterList_lanRGB.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/rasterList_lanRGB.rda -------------------------------------------------------------------------------- /data/rasterList_regRGB.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/StevenVB12/patternize/HEAD/data/rasterList_regRGB.rda -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein10.txt: -------------------------------------------------------------------------------- 1 | 272.8563 183.5832 2 | 277.5487 185.4728 3 | 283.539 187.3623 4 | 290.5276 188.854 5 | 297.5162 189.8485 6 | 303.5065 191.0419 7 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein11.txt: -------------------------------------------------------------------------------- 1 | 229.6932 174.4671 2 | 234.4854 178.3124 3 | 240.6088 182.0252 4 | 248.0633 185.738 5 | 255.3847 188.7877 6 | 265.5016 191.9701 7 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein9.txt: -------------------------------------------------------------------------------- 1 | 295.0203 182.7876 2 | 298.914 183.1854 3 | 303.4067 182.8871 4 | 310.0958 181.6937 5 | 316.3856 179.7047 6 | 321.8766 177.5168 7 | 325.4708 176.0251 8 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein4.txt: -------------------------------------------------------------------------------- 1 | 240.6088 155.4391 2 | 247.4976 151.8589 3 | 255.3847 147.2843 4 | 263.4716 141.914 5 | 270.0609 137.7371 6 | 276.5503 133.494 7 | 282.9399 129.1182 8 | 288.4643 125.1403 9 | 292.4578 121.6264 10 | 294.7873 119.7037 11 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein5.txt: -------------------------------------------------------------------------------- 1 | 246.4326 160.0801 2 | 250.7589 160.0138 3 | 255.5511 159.8812 4 | 261.142 158.6215 5 | 268.53 155.3728 6 | 276.2508 151.8589 7 | 281.9416 148.8755 8 | 288.8636 144.8975 9 | 296.7841 140.0576 10 | 303.8393 136.4112 11 | 309.8961 132.6984 12 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein7.txt: -------------------------------------------------------------------------------- 1 | 244.0698 175.6936 2 | 251.7906 176.1245 3 | 260.2768 176.3234 4 | 270.1274 175.0969 5 | 279.9781 174.0361 6 | 288.8969 172.3123 7 | 295.9521 170.3233 8 | 303.0073 167.804 9 | 310.4619 164.0912 10 | 318.3157 159.0524 11 | 322.8417 155.6048 12 | 325.1047 152.4225 13 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein3.txt: -------------------------------------------------------------------------------- 1 | 212.5544 146.1903 2 | 217.8458 148.0799 3 | 223.6364 150.1683 4 | 230.026 152.4556 5 | 234.7183 153.9474 6 | 240.2094 156.1353 7 | 246.1997 160.2127 8 | 242.306 163.1961 9 | 238.5122 166.0802 10 | 238.3125 168.3675 11 | 239.8101 171.1521 12 | 243.7037 175.0306 13 | 245.7005 177.119 14 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein6.txt: -------------------------------------------------------------------------------- 1 | 238.7119 168.467 2 | 243.7037 168.7653 3 | 249.2946 168.5664 4 | 254.2865 168.1686 5 | 262.9724 166.9752 6 | 269.5617 165.5829 7 | 277.7484 163.6934 8 | 285.8352 161.2072 9 | 293.0235 158.4226 10 | 301.8093 154.6435 11 | 308.9976 150.6655 12 | 314.7881 146.787 13 | 318.582 143.5052 14 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein1.txt: -------------------------------------------------------------------------------- 1 | 160.7386 139.2289 2 | 164.6323 137.2399 3 | 168.7256 135.2509 4 | 172.7192 133.1625 5 | 178.1104 132.168 6 | 184.1006 131.3724 7 | 191.0893 130.5768 8 | 199.3758 130.6763 9 | 205.5657 130.0796 10 | 212.9537 128.6873 11 | 220.4416 126.6983 12 | 229.2273 124.1126 13 | 236.6153 120.9302 14 | 244.5024 117.3501 15 | 251.6907 113.4715 16 | 257.1818 109.593 17 | 261.8742 105.814 18 | 262.8726 104.3222 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein2.txt: -------------------------------------------------------------------------------- 1 | 160.8385 141.6157 2 | 164.1331 142.3118 3 | 169.0252 143.1074 4 | 175.6144 143.8035 5 | 181.3052 144.4997 6 | 188.6932 145.1958 7 | 195.2825 145.6931 8 | 202.5706 146.1903 9 | 212.2549 146.2898 10 | 221.7394 143.5052 11 | 233.2208 139.8256 12 | 240.4091 137.2399 13 | 247.5974 133.7592 14 | 255.4846 129.3834 15 | 263.2719 124.0132 16 | 270.1607 117.7479 17 | 274.0544 112.5765 18 | 276.151 109.7919 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0004_landmarks_LFW.txt: -------------------------------------------------------------------------------- 1 | 178.4432 131.6045 2 | 225.5666 147.7815 3 | 246.8653 160.1132 4 | 252.1899 167.2736 5 | 240.875 172.3123 6 | 246.3328 181.992 7 | 233.0211 176.1577 8 | 249.2946 184.3788 9 | 271.0593 192.9315 10 | 285.5357 195.0199 11 | 306.3019 198.6995 12 | 312.8247 187.5612 13 | 313.4903 178.1467 14 | 310.6948 169.1299 15 | 304.1721 157.7264 16 | 294.1883 145.2621 17 | 281.9416 131.8696 18 | 270.0942 124.7093 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0049_landmarks_LFW.txt: -------------------------------------------------------------------------------- 1 | 189.0925 124.3115 2 | 237.2143 139.4278 3 | 260.9756 151.9584 4 | 267.1656 157.9253 5 | 257.3815 164.489 6 | 262.7727 174.4339 7 | 248.5958 169.1631 8 | 265.7346 176.5886 9 | 288.8969 185.2076 10 | 307.1339 187.3292 11 | 331.4943 189.7159 12 | 339.2151 175.3953 13 | 338.017 165.7155 14 | 333.6242 155.9032 15 | 326.569 145.5605 16 | 313.9229 130.4442 17 | 299.8125 117.8473 18 | 287.6989 113.2064 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0050_landmarks_LFW.txt: -------------------------------------------------------------------------------- 1 | 195.2825 138.8311 2 | 249.9935 160.0138 3 | 274.3539 176.6218 4 | 279.9448 184.2794 5 | 268.4635 189.5502 6 | 272.0576 198.4012 7 | 259.0787 192.3348 8 | 275.7516 202.2465 9 | 301.1769 214.5782 10 | 319.414 218.4236 11 | 345.5049 223.7276 12 | 354.4237 212.3241 13 | 355.7549 200.7879 14 | 355.3555 190.7104 15 | 346.9692 175.1963 16 | 335.388 159.9475 17 | 322.7419 144.3008 18 | 314.4886 136.2123 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0071_landmarks_LFW.txt: -------------------------------------------------------------------------------- 1 | 166.8287 128.5878 2 | 217.7459 148.0799 3 | 243.7037 163.5939 4 | 247.4643 170.3896 5 | 235.6169 176.6218 6 | 239.3442 187.6275 7 | 229.0942 184.0473 8 | 245.2013 191.8707 9 | 266.6331 201.9482 10 | 287.3993 206.9869 11 | 316.0195 210.6997 12 | 322.0098 201.1526 13 | 322.0098 189.4839 14 | 319.3474 177.2848 15 | 313.224 161.5055 16 | 301.776 145.0632 17 | 286.0682 129.1514 18 | 273.5552 120.3998 19 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_landmarks_LFW.txt: -------------------------------------------------------------------------------- 1 | 159.6404 140.4223 2 | 212.6209 146.2566 3 | 240.4424 155.8037 4 | 246.1664 160.1795 5 | 238.9781 166.0139 6 | 246.5658 177.4174 7 | 229.6599 174.6328 8 | 251.4911 179.3069 9 | 273.1891 183.4175 10 | 295.2865 182.6219 11 | 321.7768 180.8981 12 | 328.0666 164.2901 13 | 325.4708 152.8534 14 | 318.8482 142.7428 15 | 310.0625 132.4 16 | 295.6859 120.2009 17 | 276.6502 109.7256 18 | 264.8028 104.5543 19 | -------------------------------------------------------------------------------- /man/plotRasterstackAsImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotRasterStackAsImage.R 3 | \name{plotRasterstackAsImage} 4 | \alias{plotRasterstackAsImage} 5 | \title{Plot rasterStack as image.} 6 | \usage{ 7 | plotRasterstackAsImage(rasterStack, flipY = FALSE) 8 | } 9 | \arguments{ 10 | \item{rasterStack}{A single rasterStack.} 11 | 12 | \item{flipY}{Whether to flip the raster along the Y-axis.} 13 | } 14 | \description{ 15 | Plot rasterStack as image. 16 | } 17 | -------------------------------------------------------------------------------- /patternize.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/imageList.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{imageList} 5 | \alias{imageList} 6 | \title{imageList} 7 | \format{ 8 | A list of 5 \code{RasterStack} objects of Heliconius erato hydara dorsal forewings. 9 | } 10 | \usage{ 11 | imageList 12 | } 13 | \description{ 14 | List of RasterStacks as returned by \code{makeList}. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | data(imageList) 19 | summary(imageList) 20 | } 21 | } 22 | \keyword{datasets} 23 | -------------------------------------------------------------------------------- /man/landmarkList.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{landmarkList} 5 | \alias{landmarkList} 6 | \title{landmarkList} 7 | \format{ 8 | A list of landmarks for 5 Heliconius erato hydara dorsal forewings. 9 | } 10 | \usage{ 11 | landmarkList 12 | } 13 | \description{ 14 | List of landmarks as returned by \code{makeList}. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | data(landmarkList) 19 | summary(landmarkList) 20 | } 21 | } 22 | \keyword{datasets} 23 | -------------------------------------------------------------------------------- /man/landmarkArray.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{landmarkArray} 5 | \alias{landmarkArray} 6 | \title{landmarkArray} 7 | \format{ 8 | An array of landmarks for 5 Heliconius erato hydara dorsal forewings. 9 | } 10 | \usage{ 11 | landmarkArray 12 | } 13 | \description{ 14 | Array of landmarks as returned by \code{lanArray} and used by 15 | \code{link[Morpho]{procsym}}. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | data(landmarkArray) 20 | summary(landmarkArray) 21 | } 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_vein8.txt: -------------------------------------------------------------------------------- 1 | 160.4391 142.9085 2 | 164.233 145.0964 3 | 169.0252 148.1793 4 | 174.9156 151.1628 5 | 181.405 154.5441 6 | 188.2938 158.3231 7 | 195.7817 161.9033 8 | 202.1713 164.7873 9 | 209.3596 167.9697 10 | 216.8474 170.6548 11 | 225.733 173.2405 12 | 235.1177 175.5278 13 | 244.7021 177.2185 14 | 252.6891 179.3069 15 | 261.8742 181.3953 16 | 271.1591 183.086 17 | 273.1558 183.6827 18 | 281.4424 183.1854 19 | 290.8271 183.2849 20 | 295.3198 182.7876 21 | 300.112 180.1025 22 | 306.6015 177.6163 23 | 313.6899 173.7378 24 | 319.9797 169.9587 25 | 324.6721 166.8758 26 | 328.4659 164.5884 27 | -------------------------------------------------------------------------------- /man/rasterList_lanK.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{rasterList_lanK} 5 | \alias{rasterList_lanK} 6 | \title{rasterList_lanK} 7 | \format{ 8 | A list of RasterLayers including the red color pattern extracted from 5 Heliconius 9 | erato hydara dorsal forewings using \code{patLanK}. 10 | } 11 | \usage{ 12 | rasterList_lanK 13 | } 14 | \description{ 15 | List of RasterLayers as returned by \code{patLanK}. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | data(rasterList_lanK) 20 | summary(rasterList_lanL) 21 | } 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /man/rasterList_regK.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{rasterList_regK} 5 | \alias{rasterList_regK} 6 | \title{rasterList_regK} 7 | \format{ 8 | A list of RasterLayers including the red color pattern extracted from 5 Heliconius 9 | erato hydara dorsal forewings using \code{patRegK}. 10 | } 11 | \usage{ 12 | rasterList_regK 13 | } 14 | \description{ 15 | List of RasterLayers as returned by \code{patRegK}. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | data(rasterList_regK) 20 | summary(rasterList_regK) 21 | } 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /man/setMask.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/setMask.R 3 | \name{setMask} 4 | \alias{setMask} 5 | \title{Interactive function to to draw an outline for masking.} 6 | \usage{ 7 | setMask(summedRaster, IDlist, filename, ...) 8 | } 9 | \arguments{ 10 | \item{summedRaster}{Summed raster of extracted patterns.} 11 | 12 | \item{IDlist}{List of sample IDs.} 13 | 14 | \item{filename}{Name of file to which mask will be written.} 15 | 16 | \item{...}{additional arguments for plotHeat function.} 17 | } 18 | \value{ 19 | file 20 | } 21 | \description{ 22 | Interactive function to to draw an outline for masking. 23 | } 24 | -------------------------------------------------------------------------------- /man/rasterList_lanRGB.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{rasterList_lanRGB} 5 | \alias{rasterList_lanRGB} 6 | \title{rasterList_lanRGB} 7 | \format{ 8 | A list of RasterLayers including the red color pattern extracted from 5 Heliconius 9 | erato hydara dorsal forewings using \code{patLanRGB}. 10 | } 11 | \usage{ 12 | rasterList_lanRGB 13 | } 14 | \description{ 15 | List of RasterLayers as returned by \code{patLanRGB}. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | data(rasterList_lanRGB) 20 | summary(rasterList_lanRGB) 21 | } 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /man/rasterList_regRGB.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{rasterList_regRGB} 5 | \alias{rasterList_regRGB} 6 | \title{rasterList_regRGB} 7 | \format{ 8 | A list of RasterLayers including the red color pattern extracted from 5 Heliconius 9 | erato hydara dorsal forewings using \code{patRegRGB}. 10 | } 11 | \usage{ 12 | rasterList_regRGB 13 | } 14 | \description{ 15 | List of RasterLayers as returned by \code{patRegRGB}. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | data(rasterList_regRGB) 20 | summary(rasterList_regRGB) 21 | } 22 | } 23 | \keyword{datasets} 24 | -------------------------------------------------------------------------------- /R/plotRasterStackAsImage.R: -------------------------------------------------------------------------------- 1 | #' Plot rasterStack as image. 2 | #' 3 | #' @param rasterStack A single rasterStack. 4 | #' @param flipY Whether to flip the raster along the Y-axis. 5 | #' 6 | #' @export 7 | #' @import raster 8 | 9 | plotRasterstackAsImage <- function(rasterStack, 10 | flipY = FALSE){ 11 | 12 | if(flipY){ 13 | rasterStack <- raster::flip(rasterStack,'y') 14 | } 15 | 16 | x <- as.array(rasterStack)/255 17 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 18 | uniqueCols <- unique(cols) 19 | x2 <- match(cols, uniqueCols) 20 | dim(x2) <- dim(x)[1:2] 21 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 22 | 23 | } 24 | -------------------------------------------------------------------------------- /man/redRes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/redRes.R 3 | \name{redRes} 4 | \alias{redRes} 5 | \title{Reduce the resolution of an image imported as a RasterStack by downsampling.} 6 | \usage{ 7 | redRes(image, resampleFactor) 8 | } 9 | \arguments{ 10 | \item{image}{RasterStack for downsampling.} 11 | 12 | \item{resampleFactor}{Integer for downsampling.} 13 | } 14 | \value{ 15 | Downsampled RasterStack 16 | } 17 | \description{ 18 | Reduce the resolution of an image imported as a RasterStack by downsampling. 19 | } 20 | \examples{ 21 | image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 22 | image_reduced <- redRes(image, 5) 23 | 24 | } 25 | -------------------------------------------------------------------------------- /R/redRes.R: -------------------------------------------------------------------------------- 1 | #' Reduce the resolution of an image imported as a RasterStack by downsampling. 2 | #' 3 | #' @param image RasterStack for downsampling. 4 | #' @param resampleFactor Integer for downsampling. 5 | #' 6 | #' @return Downsampled RasterStack 7 | #' 8 | #' @examples 9 | #' image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 10 | #' image_reduced <- redRes(image, 5) 11 | #' 12 | #' @export 13 | #' @import raster 14 | 15 | redRes <- function(image, 16 | resampleFactor){ 17 | 18 | inCols <- ncol(image) 19 | inRows <- nrow(image) 20 | 21 | resampledRaster <- raster::raster(ncol=(inCols/resampleFactor), nrow=(inRows/resampleFactor)) 22 | 23 | raster::extent(resampledRaster) <- raster::extent(image) 24 | 25 | resampled <- raster::resample(image, resampledRaster) 26 | 27 | return(resampled) 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/GMMImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/GMMImage.R 3 | \name{GMMImage} 4 | \alias{GMMImage} 5 | \title{\code{\link[ClusterR]{GMM}} clustering of image imported as a RasterStack.} 6 | \usage{ 7 | GMMImage(image, k = 5, maskToNA = NULL, kmeansOnAll = FALSE) 8 | } 9 | \arguments{ 10 | \item{image}{Image imported as a RasterStack for clustering.} 11 | 12 | \item{k}{Integer for number of k clusters (default = 3).} 13 | 14 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 15 | 16 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 17 | first (default = FALSE).} 18 | } 19 | \value{ 20 | List including the clustered \code{RasterSatck} returned as an array and object 21 | of class "\code{GMM}". 22 | } 23 | \description{ 24 | \code{\link[ClusterR]{GMM}} clustering of image imported as a RasterStack. 25 | } 26 | -------------------------------------------------------------------------------- /man/sampleLandmarks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sampleLandmarks.R 3 | \name{sampleLandmarks} 4 | \alias{sampleLandmarks} 5 | \title{Sample landmarks in an image.} 6 | \usage{ 7 | sampleLandmarks(sampleList, resampleFactor = NULL, crop = c(0, 0, 0, 0)) 8 | } 9 | \arguments{ 10 | \item{sampleList}{RasterStack or list of RasterStack objects as obtained 11 | by \code{\link{makeList}}.} 12 | 13 | \item{resampleFactor}{Integer for downsampling the image(s) used by \code{\link{redRes}}.} 14 | 15 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 16 | original image.} 17 | } 18 | \value{ 19 | landmark matrix or landmark list 20 | } 21 | \description{ 22 | Sample landmarks in an image. 23 | } 24 | \examples{ 25 | 26 | \dontrun{ 27 | IDlist <- c('BC0077','BC0071') 28 | prepath <- system.file("extdata", package = 'patternize') 29 | extension <- '.jpg' 30 | imageList <- makeList(IDlist, 'image', prepath, extension) 31 | 32 | landmarkList <- sampleLandmarks(imageList) 33 | } 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/sumRaster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sumRaster.R 3 | \name{sumRaster} 4 | \alias{sumRaster} 5 | \title{This function sums the individual color pattern RasterLayes as obtained by the main patternize 6 | functions.} 7 | \usage{ 8 | sumRaster(rList, IDlist, type) 9 | } 10 | \arguments{ 11 | \item{rList}{List of RasterLayers or list of RasterLayers for each k-means cluster.} 12 | 13 | \item{IDlist}{List of sample IDs.} 14 | 15 | \item{type}{Type of rasterlist; 'RGB' or 'k' (result from RGB or k-means analysis, respectively).} 16 | } 17 | \description{ 18 | This function sums the individual color pattern RasterLayes as obtained by the main patternize 19 | functions. 20 | } 21 | \examples{ 22 | data(rasterList_lanRGB) 23 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 24 | summedRaster <- sumRaster(rasterList_lanRGB, IDlist, type = 'RGB') 25 | 26 | data(rasterList_lanK) 27 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 28 | summedRasterList <- sumRaster(rasterList_lanK, IDlist, type = 'k') 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/sampleRGB.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sampleRGB.R 3 | \name{sampleRGB} 4 | \alias{sampleRGB} 5 | \title{Interactive function to sample RGB value from pixel or square area in an image.} 6 | \usage{ 7 | sampleRGB(image, resampleFactor = NULL, crop = c(0, 0, 0, 0), type = "point") 8 | } 9 | \arguments{ 10 | \item{image}{Image imported as a RasterStack.} 11 | 12 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 13 | 14 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 15 | original image.} 16 | 17 | \item{type}{Set 'point' to extract RGB from a single point or 'area' to extract from a square 18 | area defined by setting two points (default = 'point').} 19 | } 20 | \value{ 21 | RGB vector 22 | } 23 | \description{ 24 | Interactive function to sample RGB value from pixel or square area in an image. 25 | } 26 | \examples{ 27 | image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 28 | RGB <- sampleRGB(image, resampleFactor = 1) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: patternize 2 | Title: Quantification of Color Pattern Variation 3 | Version: 0.0.5 4 | Authors@R: person("Steven", "Van Belleghem", email = "vanbelleghemsteven@hotmail.com", role = c("aut", "cre")) 5 | Maintainer: Steven Van Belleghem 6 | Description: Quantification of variation in organismal color patterns as 7 | obtained from image data. Patternize defines homology between pattern positions 8 | across images either through fixed landmarks or image registration. Pattern 9 | identification is performed by categorizing the distribution of colors using RGB 10 | thresholds or image segmentation. 11 | BugReports: https://github.com/StevenVB12/patternize/issues 12 | URL: https://github.com/StevenVB12/patternize 13 | Depends: 14 | R (>= 3.5.0) 15 | Imports: 16 | raster, 17 | sp, 18 | sf, 19 | abind, 20 | Morpho, 21 | dplyr, 22 | imager, 23 | magrittr, 24 | methods, 25 | purrr, 26 | vegan, 27 | RNiftyReg, 28 | geomorph, 29 | ClusterR 30 | License: GPL-3 31 | Encoding: UTF-8 32 | LazyData: true 33 | RoxygenNote: 7.2.3 34 | -------------------------------------------------------------------------------- /man/kImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kImage.R 3 | \name{kImage} 4 | \alias{kImage} 5 | \title{\code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 6 | used by \code{patLanK} and \code{patRegK}.} 7 | \usage{ 8 | kImage(image, k = 5, startCenter = NULL, maskToNA = NULL, kmeansOnAll = FALSE) 9 | } 10 | \arguments{ 11 | \item{image}{Image imported as a RasterStack for k-means clustering.} 12 | 13 | \item{k}{Integer for number of k-means clusters (default = 3).} 14 | 15 | \item{startCenter}{A matrix of cluster centres to start k-means clustering from (default = NULL).} 16 | 17 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 18 | 19 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 20 | first (default = FALSE).} 21 | } 22 | \value{ 23 | List including the k-means clustered \code{RasterSatck} returned as an array and object 24 | of class "\code{kmeans}". 25 | } 26 | \description{ 27 | \code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 28 | used by \code{patLanK} and \code{patRegK}. 29 | } 30 | \examples{ 31 | image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 32 | out <- kImage(image, 6) 33 | 34 | } 35 | -------------------------------------------------------------------------------- /man/lanArray.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lanArray.R 3 | \name{lanArray} 4 | \alias{lanArray} 5 | \title{Build landmark array for \code{\link[Morpho]{Morpho}}.} 6 | \usage{ 7 | lanArray(sampleList, adjustCoords = FALSE, imageList = NULL, imageIDs = NULL) 8 | } 9 | \arguments{ 10 | \item{sampleList}{List of landmark matrices as returned by \code{\link{makeList}}.} 11 | 12 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 13 | coordinates (default = FALSE).} 14 | 15 | \item{imageList}{List of RasterStacks as returned by \code{\link{makeList}} should be given 16 | when \code{adjustCoords = TRUE}.} 17 | 18 | \item{imageIDs}{A list of IDs to match landmarks to images if landmarkList and imageList don't 19 | have the same length.} 20 | } 21 | \value{ 22 | X x Y x n array, where X and Y define the coordinates of the landmark points and n 23 | is the sample size. 24 | } 25 | \description{ 26 | Build landmark array for \code{\link[Morpho]{Morpho}}. 27 | } 28 | \examples{ 29 | 30 | \dontrun{ 31 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 32 | 33 | prepath <- system.file("extdata", package = 'patternize') 34 | extension <- '_landmarks_LFW.txt' 35 | 36 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 37 | 38 | landmarkArray <- lanArray(landmarkList) 39 | } 40 | 41 | } 42 | -------------------------------------------------------------------------------- /R/extdata.R: -------------------------------------------------------------------------------- 1 | #' @title External patternize data 2 | #' 3 | #' @description Raw image, landmark and cartoon data of Heliconius erato hydara wings. 4 | #' 5 | #' @name extdata 6 | #' 7 | #' @format Raw JPG images, landmark and cartoon data. 8 | #' \describe{ 9 | #' \item{BC0077.JPG}{jpeg image} 10 | #' \item{BC0071.JPG}{jpeg image} 11 | #' \item{BC0050.JPG}{jpeg image} 12 | #' \item{BC0049.JPG}{jpeg image} 13 | #' \item{BC0004.JPG}{jpeg image} 14 | #' \item{BC0077_landmarks_LFW.Txt}{xy landmark coordinates} 15 | #' \item{BC0071_landmarks_LFW.Txt}{xy landmark coordinates} 16 | #' \item{BC0050_landmarks_LFW.Txt}{xy landmark coordinates} 17 | #' \item{BC0049_landmarks_LFW.Txt}{xy landmark coordinates} 18 | #' \item{BC0004_landmarks_LFW.Txt}{xy landmark coordinates} 19 | #' \item{BC0077_outline.txt}{xy outline coordinates} 20 | #' \item{BC0077_vein1.txt}{xy vein coordinates} 21 | #' \item{BC0077_vein2.txt}{xy vein coordinates} 22 | #' \item{BC0077_vein3.txt}{xy vein coordinates} 23 | #' \item{BC0077_vein4.txt}{xy vein coordinates} 24 | #' \item{BC0077_vein5.txt}{xy vein coordinates} 25 | #' \item{BC0077_vein6.txt}{xy vein coordinates} 26 | #' \item{BC0077_vein7.txt}{xy vein coordinates} 27 | #' \item{BC0077_vein8.txt}{xy vein coordinates} 28 | #' \item{BC0077_vein9.txt}{xy vein coordinates} 29 | #' \item{BC0077_vein10.txt}{xy vein coordinates} 30 | #' \item{BC0077_vein11.txt}{xy vein coordinates} 31 | #' } 32 | NULL 33 | -------------------------------------------------------------------------------- /man/createTarget.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/createTarget.R 3 | \name{createTarget} 4 | \alias{createTarget} 5 | \title{Create a target image (RasterStack) from a polygon.} 6 | \usage{ 7 | createTarget( 8 | outline, 9 | image, 10 | res = 300, 11 | colorFill = "black", 12 | colorBG = "white", 13 | sigma = 10, 14 | plot = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{outline}{xy coordinates that define outline.} 19 | 20 | \item{image}{Image imported as RasterStack used in the analysis. This is used to extract 21 | the extent and dimensions for the raster layers.} 22 | 23 | \item{res}{Resolution for RasterStack (default = 300).} 24 | 25 | \item{colorFill}{Color for the fill of the polygon (default = 'black').} 26 | 27 | \item{colorBG}{Color for the background (default = 'white').} 28 | 29 | \item{sigma}{Size of sigma for Gaussian blurring (default = 10).} 30 | 31 | \item{plot}{Whether to plot the created target image (default = FALSE).} 32 | } 33 | \value{ 34 | RasterStack 35 | } 36 | \description{ 37 | Create a target image (RasterStack) from a polygon. 38 | } 39 | \examples{ 40 | 41 | \dontrun{ 42 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 43 | '/BC0077_outline.txt', sep=''), header = FALSE) 44 | 45 | data(imageList) 46 | 47 | target <- createTarget(outline_BC0077, imageList[[1]], plot = TRUE) 48 | } 49 | 50 | } 51 | -------------------------------------------------------------------------------- /man/makeList.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/makeList.R 3 | \name{makeList} 4 | \alias{makeList} 5 | \title{Build list of landmarks or RasterStacks from images using filepath and file extension.} 6 | \usage{ 7 | makeList( 8 | IDlist, 9 | type, 10 | prepath = NULL, 11 | extension = NULL, 12 | format = "imageJ", 13 | tpsFile = NULL, 14 | skipLandmark = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{IDlist}{List of sample IDs.} 19 | 20 | \item{type}{'landmark' or 'image' depending on what type of list to make.} 21 | 22 | \item{prepath}{Prepath (default = NULL).} 23 | 24 | \item{extension}{Extension (default = NULL).} 25 | 26 | \item{format}{ImageJ (Fiji) or tps format (default = 'imageJ').} 27 | 28 | \item{tpsFile}{Provide filename of tps file ff format is 'tps'.} 29 | 30 | \item{skipLandmark}{Vector of rownumbers of landmarks to skip.} 31 | } 32 | \value{ 33 | Landmark or RasterStack list. 34 | } 35 | \description{ 36 | Build list of landmarks or RasterStacks from images using filepath and file extension. 37 | } 38 | \examples{ 39 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 40 | 41 | prepath <- system.file("extdata", package = 'patternize') 42 | extension <- '_landmarks_LFW.txt' 43 | 44 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 45 | 46 | extension <- '.jpg' 47 | imageList <- makeList(IDlist, 'image', prepath, extension) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/extdata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extdata.R 3 | \name{extdata} 4 | \alias{extdata} 5 | \title{External patternize data} 6 | \format{ 7 | Raw JPG images, landmark and cartoon data. 8 | \describe{ 9 | \item{BC0077.JPG}{jpeg image} 10 | \item{BC0071.JPG}{jpeg image} 11 | \item{BC0050.JPG}{jpeg image} 12 | \item{BC0049.JPG}{jpeg image} 13 | \item{BC0004.JPG}{jpeg image} 14 | \item{BC0077_landmarks_LFW.Txt}{xy landmark coordinates} 15 | \item{BC0071_landmarks_LFW.Txt}{xy landmark coordinates} 16 | \item{BC0050_landmarks_LFW.Txt}{xy landmark coordinates} 17 | \item{BC0049_landmarks_LFW.Txt}{xy landmark coordinates} 18 | \item{BC0004_landmarks_LFW.Txt}{xy landmark coordinates} 19 | \item{BC0077_outline.txt}{xy outline coordinates} 20 | \item{BC0077_vein1.txt}{xy vein coordinates} 21 | \item{BC0077_vein2.txt}{xy vein coordinates} 22 | \item{BC0077_vein3.txt}{xy vein coordinates} 23 | \item{BC0077_vein4.txt}{xy vein coordinates} 24 | \item{BC0077_vein5.txt}{xy vein coordinates} 25 | \item{BC0077_vein6.txt}{xy vein coordinates} 26 | \item{BC0077_vein7.txt}{xy vein coordinates} 27 | \item{BC0077_vein8.txt}{xy vein coordinates} 28 | \item{BC0077_vein9.txt}{xy vein coordinates} 29 | \item{BC0077_vein10.txt}{xy vein coordinates} 30 | \item{BC0077_vein11.txt}{xy vein coordinates} 31 | } 32 | } 33 | \description{ 34 | Raw image, landmark and cartoon data of Heliconius erato hydara wings. 35 | } 36 | -------------------------------------------------------------------------------- /man/patGMM.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patGMM.R 3 | \name{patGMM} 4 | \alias{patGMM} 5 | \title{Extract colors using GMM clustering (for pre-aligned images).} 6 | \usage{ 7 | patGMM( 8 | sampleList, 9 | k = 3, 10 | resampleFactor = NULL, 11 | maskOutline = NULL, 12 | plot = FALSE, 13 | focal = FALSE, 14 | sigma = 3, 15 | maskToNA = NULL, 16 | kmeansOnAll = FALSE 17 | ) 18 | } 19 | \arguments{ 20 | \item{sampleList}{List of RasterStack objects.} 21 | 22 | \item{k}{Integere for defining number of clusters (default = 3).} 23 | 24 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 25 | 26 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 27 | the color extraction (default = NULL).} 28 | 29 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE).} 30 | 31 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 32 | 33 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 34 | 35 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 36 | 37 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 38 | first (default = FALSE).} 39 | } 40 | \value{ 41 | List of summed raster for each k-means cluster objects. 42 | } 43 | \description{ 44 | Extract colors using GMM clustering (for pre-aligned images). 45 | } 46 | -------------------------------------------------------------------------------- /man/kImageHSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/kImageHSV.R 3 | \name{kImageHSV} 4 | \alias{kImageHSV} 5 | \title{\code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 6 | used by \code{patLanK} and \code{patRegK}.} 7 | \usage{ 8 | kImageHSV( 9 | image, 10 | k = 5, 11 | startCenter = NULL, 12 | maskToNA = NULL, 13 | kmeansOnAll = FALSE, 14 | ignoreHSVvalue = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{image}{HSV image imported as a RasterStack for k-means clustering.} 19 | 20 | \item{k}{Integer for number of k-means clusters (default = 3).} 21 | 22 | \item{startCenter}{A matrix of cluster centres to start k-means clustering from (default = NULL).} 23 | 24 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 25 | 26 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 27 | first (default = FALSE).} 28 | 29 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 30 | } 31 | \value{ 32 | List including the k-means clustered \code{RasterSatck} returned as an array and object 33 | of class "\code{kmeans}". 34 | } 35 | \description{ 36 | \code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 37 | used by \code{patLanK} and \code{patRegK}. 38 | } 39 | \examples{ 40 | image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 41 | out <- kImage(image, 6) 42 | 43 | } 44 | -------------------------------------------------------------------------------- /R/setMask.R: -------------------------------------------------------------------------------- 1 | #' Interactive function to to draw an outline for masking. 2 | #' 3 | #' @param summedRaster Summed raster of extracted patterns. 4 | #' @param IDlist List of sample IDs. 5 | #' @param filename Name of file to which mask will be written. 6 | #' @param ... additional arguments for plotHeat function. 7 | #' 8 | #' @return file 9 | #' 10 | #' @export 11 | #' @import raster 12 | #' @importFrom graphics locator 13 | #' @importFrom utils write.table 14 | 15 | setMask <- function(summedRaster, 16 | IDlist, 17 | filename, 18 | ...){ 19 | 20 | plotHeat(summedRaster, IDlist, ...) 21 | 22 | print("Choose points to mask patterns. Click outside image area to stop.") 23 | 24 | n = 1 25 | 26 | outline <- c() 27 | 28 | while(1){ 29 | 30 | xy <- locator(n=1) 31 | 32 | n <- n + 1 33 | 34 | if(any(c(as.numeric(xy)[1] < raster::extent(summedRaster)[1], 35 | as.numeric(xy)[1] > raster::extent(summedRaster)[2], 36 | as.numeric(xy)[2] < raster::extent(summedRaster)[3], 37 | as.numeric(xy)[2] > raster::extent(summedRaster)[4]))){ 38 | print("done") 39 | break 40 | } 41 | 42 | outline <- rbind(outline, as.numeric(xy)) 43 | colnames(outline) <- c("x", "y") 44 | 45 | print(paste('x: ', as.character(xy)[1], 'y: ', as.character(xy)[2])) 46 | 47 | if(n > 1){ 48 | lines(outline[c(n-1:n),], col = 'green', lwd = 2) 49 | } 50 | } 51 | 52 | write.table(outline, file = filename, quote = FALSE) 53 | 54 | } 55 | -------------------------------------------------------------------------------- /man/patK.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patK.R 3 | \name{patK} 4 | \alias{patK} 5 | \title{Extract colors using k-means clustering (for pre-aligned images).} 6 | \usage{ 7 | patK( 8 | sampleList, 9 | k = 3, 10 | fixedStartCenter = NULL, 11 | resampleFactor = NULL, 12 | maskOutline = NULL, 13 | plot = FALSE, 14 | focal = FALSE, 15 | sigma = 3, 16 | maskToNA = NULL, 17 | kmeansOnAll = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{sampleList}{List of RasterStack objects.} 22 | 23 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 24 | 25 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 26 | 27 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 28 | 29 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 30 | the color extraction (default = NULL).} 31 | 32 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE).} 33 | 34 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 35 | 36 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 37 | 38 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 39 | 40 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 41 | first (default = FALSE).} 42 | } 43 | \value{ 44 | List of summed raster for each k-means cluster objects. 45 | } 46 | \description{ 47 | Extract colors using k-means clustering (for pre-aligned images). 48 | } 49 | -------------------------------------------------------------------------------- /man/alignReg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/alignReg.R 3 | \name{alignReg} 4 | \alias{alignReg} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration..} 6 | \usage{ 7 | alignReg( 8 | sampleList, 9 | target, 10 | resampleFactor = NULL, 11 | useBlockPercentage = 75, 12 | crop = c(0, 0, 0, 0), 13 | removebgR = NULL, 14 | maskOutline = NULL, 15 | plotTransformed = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{sampleList}{List of RasterStack objects.} 20 | 21 | \item{target}{Image imported as RasterStack used as target for registration.} 22 | 23 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}} (default = NULL).} 24 | 25 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 26 | (default = 75).} 27 | 28 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 29 | original image.} 30 | 31 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 32 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 33 | remove a white background.} 34 | 35 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 36 | the color extraction (default = NULL).} 37 | 38 | \item{plotTransformed}{Whether to plot transformed images while processing (default = FALSE).} 39 | } 40 | \value{ 41 | List of raster objects. 42 | } 43 | \description{ 44 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration.. 45 | } 46 | -------------------------------------------------------------------------------- /man/colorChecker_customGray.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorChecker_customGray.R 3 | \name{colorChecker_customGray} 4 | \alias{colorChecker_customGray} 5 | \title{Calibrate images using ColorChecker.} 6 | \usage{ 7 | colorChecker_customGray( 8 | IDlist, 9 | prepath = NULL, 10 | extension = NULL, 11 | colorCheckerType = "X-Rite", 12 | fixedCorners = FALSE, 13 | patchSize = 0.6, 14 | colorCheckerXY = NULL, 15 | fixedModel = NULL, 16 | resampleFactor = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{IDlist}{List of sample IDs.} 21 | 22 | \item{prepath}{Prepath (default = NULL).} 23 | 24 | \item{extension}{Extension (default = NULL).} 25 | 26 | \item{colorCheckerType}{Type of colorChecker. Options are 'X-Rite ' and 'ColorGauge Micro 27 | Analyzer' (default = 'X-Rite ').} 28 | 29 | \item{fixedCorners}{Specify whether to set the coordinates of the colorChecker corners 30 | for every image (default = FALSE).} 31 | 32 | \item{patchSize}{Proportion of ColorChecker patch that will be used for observed RGB values 33 | (default = 0.6).} 34 | 35 | \item{colorCheckerXY}{Landmark list of colorChecker corners as returned 36 | by \code{\link[patternize]{makeList}}. The image will not be plotted.} 37 | 38 | \item{fixedModel}{Precalculated model to adjust colors. Should be a listof a model for R, G 39 | and B (the colorChecker function gives as output such a list obtained from the last image 40 | in the analysis).} 41 | 42 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 43 | } 44 | \value{ 45 | Calibrated image(s) ('filename_calibrated.jpg') 46 | } 47 | \description{ 48 | Calibrate images using ColorChecker. 49 | } 50 | -------------------------------------------------------------------------------- /man/patK_HSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patK_HSV.R 3 | \name{patK_HSV} 4 | \alias{patK_HSV} 5 | \title{Extract colors using k-means clustering (for pre-aligned images).} 6 | \usage{ 7 | patK_HSV( 8 | sampleList, 9 | k = 3, 10 | fixedStartCenter = NULL, 11 | resampleFactor = NULL, 12 | maskOutline = NULL, 13 | plot = FALSE, 14 | focal = FALSE, 15 | sigma = 3, 16 | maskToNA = NULL, 17 | kmeansOnAll = FALSE, 18 | ignoreHSVvalue = FALSE 19 | ) 20 | } 21 | \arguments{ 22 | \item{sampleList}{List of RasterStack objects.} 23 | 24 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 25 | 26 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 27 | 28 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 29 | 30 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 31 | the color extraction (default = NULL).} 32 | 33 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE).} 34 | 35 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 36 | 37 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 38 | 39 | \item{maskToNA}{Replace the color value used for masking (i.e. 0 or 255) with NA.} 40 | 41 | \item{kmeansOnAll}{Whether to perform the kmeans clusters on the combined set of pixels of all images 42 | first (default = FALSE).} 43 | 44 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 45 | } 46 | \value{ 47 | List of summed raster for each k-means cluster objects. 48 | } 49 | \description{ 50 | Extract colors using k-means clustering (for pre-aligned images). 51 | } 52 | -------------------------------------------------------------------------------- /man/colorChecker.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorChecker.R 3 | \name{colorChecker} 4 | \alias{colorChecker} 5 | \title{Calibrate images using ColorChecker.} 6 | \usage{ 7 | colorChecker( 8 | IDlist, 9 | prepath = NULL, 10 | extension = NULL, 11 | colorCheckerType = "X-Rite", 12 | fixedCorners = FALSE, 13 | patchSize = 0.6, 14 | colorCheckerXY = NULL, 15 | fixedModel = NULL, 16 | resampleFactor = NULL, 17 | adjustCoords = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{IDlist}{List of sample IDs.} 22 | 23 | \item{prepath}{Prepath (default = NULL).} 24 | 25 | \item{extension}{Extension (default = NULL).} 26 | 27 | \item{colorCheckerType}{Type of colorChecker. Options are 'X-Rite ' and 'ColorGauge Micro 28 | Analyzer' (default = 'X-Rite ').} 29 | 30 | \item{fixedCorners}{Specify whether to set the coordinates of the colorChecker corners 31 | for every image (default = FALSE).} 32 | 33 | \item{patchSize}{Proportion of ColorChecker patch that will be used for observed RGB values 34 | (default = 0.6).} 35 | 36 | \item{colorCheckerXY}{Landmark list of colorChecker corners as returned 37 | by \code{\link[patternize]{makeList}}. The image will not be plotted.} 38 | 39 | \item{fixedModel}{Precalculated model to adjust colors. Should be a listof a model for R, G 40 | and B (the colorChecker function gives as output such a list obtained from the last image 41 | in the analysis).} 42 | 43 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 44 | 45 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 46 | coordinates (default = FALSE).} 47 | } 48 | \value{ 49 | Calibrated image(s) ('filename_calibrated.jpg') 50 | } 51 | \description{ 52 | Calibrate images using ColorChecker. 53 | } 54 | -------------------------------------------------------------------------------- /man/colorChecker_half.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorChecker_half.R 3 | \name{colorChecker_half} 4 | \alias{colorChecker_half} 5 | \title{Calibrate images using (right) half of ColorChecker. Only works for X-Rite.} 6 | \usage{ 7 | colorChecker_half( 8 | IDlist, 9 | prepath = NULL, 10 | extension = NULL, 11 | colorCheckerType = "X-Rite", 12 | fixedCorners = FALSE, 13 | patchSize = 0.6, 14 | colorCheckerXY = NULL, 15 | fixedModel = NULL, 16 | resampleFactor = NULL, 17 | adjustCoords = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{IDlist}{List of sample IDs.} 22 | 23 | \item{prepath}{Prepath (default = NULL).} 24 | 25 | \item{extension}{Extension (default = NULL).} 26 | 27 | \item{colorCheckerType}{Type of colorChecker. Options are 'X-Rite ' and 'ColorGauge Micro 28 | Analyzer' (default = 'X-Rite').} 29 | 30 | \item{fixedCorners}{Specify whether to set the coordinates of the colorChecker corners 31 | for every image (default = FALSE).} 32 | 33 | \item{patchSize}{Proportion of ColorChecker patch that will be used for observed RGB values 34 | (default = 0.6).} 35 | 36 | \item{colorCheckerXY}{Landmark list of colorChecker corners as returned 37 | by \code{\link[patternize]{makeList}}. The image will not be plotted.} 38 | 39 | \item{fixedModel}{Precalculated model to adjust colors. Should be a listof a model for R, G 40 | and B (the colorChecker function gives as output such a list obtained from the last image 41 | in the analysis).} 42 | 43 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 44 | 45 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 46 | coordinates (default = FALSE).} 47 | } 48 | \value{ 49 | Calibrated image(s) ('filename_calibrated.jpg') 50 | } 51 | \description{ 52 | Calibrate images using (right) half of ColorChecker. Only works for X-Rite. 53 | } 54 | -------------------------------------------------------------------------------- /inst/extdata/BC0077_outline.txt: -------------------------------------------------------------------------------- 1 | 160.7386 130.4774 2 | 165.5308 127.4939 3 | 168.6258 125.6043 4 | 170.9221 124.6099 5 | 174.4164 123.4165 6 | 177.112 122.5214 7 | 181.7045 121.7258 8 | 185.4984 121.2286 9 | 188.5933 120.9302 10 | 191.9878 120.5324 11 | 195.6818 120.1346 12 | 199.276 119.5379 13 | 204.9667 118.444 14 | 211.556 117.2506 15 | 218.0455 115.6594 16 | 225.3336 113.4715 17 | 231.8231 111.3831 18 | 237.8133 109.1952 19 | 244.2029 106.8084 20 | 248.3961 105.3167 21 | 252.0901 104.3222 22 | 255.0852 103.825 23 | 257.9805 103.6261 24 | 261.1753 103.7255 25 | 264.0706 104.4217 26 | 266.9659 105.2173 27 | 270.1607 106.5101 28 | 273.1558 107.8029 29 | 276.2508 109.1952 30 | 280.2443 111.3831 31 | 282.8401 112.9743 32 | 285.1364 114.2671 33 | 287.5325 115.3611 34 | 290.9269 117.0517 35 | 294.1218 118.7424 36 | 296.0187 120.1346 37 | 297.8157 121.4275 38 | 300.2119 123.7148 39 | 302.608 126.201 40 | 303.5065 126.4994 41 | 304.9042 127.5933 42 | 310.4951 132.9636 43 | 314.4886 137.5382 44 | 318.7817 142.9085 45 | 320.8782 145.2953 46 | 322.276 147.881 47 | 323.1745 148.5771 48 | 325.2711 152.3562 49 | 326.6688 156.0358 50 | 327.4675 159.0193 51 | 327.9667 160.8094 52 | 328.4659 163.395 53 | 328.4659 165.7818 54 | 327.8669 169.9587 55 | 326.8685 172.7433 56 | 325.4708 176.224 57 | 323.5739 179.6053 58 | 320.9781 182.2904 59 | 317.8831 184.7766 60 | 314.1891 187.064 61 | 310.3953 189.0529 62 | 306.2021 190.843 63 | 300.8109 192.2353 64 | 295.9188 193.2298 65 | 290.7273 193.7271 66 | 283.4391 194.0254 67 | 277.2492 193.9259 68 | 270.9594 193.3293 69 | 265.2687 192.5337 70 | 259.0787 191.1414 71 | 251.2914 189.1524 72 | 241.6071 186.2684 73 | 232.6218 183.2849 74 | 225.3336 181.097 75 | 217.8458 178.6108 76 | 211.2565 176.3234 77 | 202.7703 172.9422 78 | 193.5852 168.9642 79 | 183.1023 163.6934 80 | 177.2119 160.511 81 | 171.9205 157.2292 82 | 166.6291 153.4501 83 | 162.8352 150.765 84 | 158.9416 147.9804 85 | -------------------------------------------------------------------------------- /R/lanArray.R: -------------------------------------------------------------------------------- 1 | #' Build landmark array for \code{\link[Morpho]{Morpho}}. 2 | #' 3 | #' @param sampleList List of landmark matrices as returned by \code{\link{makeList}}. 4 | #' @param adjustCoords Adjust landmark coordinates in case they are reversed compared to pixel 5 | #' coordinates (default = FALSE). 6 | #' @param imageList List of RasterStacks as returned by \code{\link{makeList}} should be given 7 | #' when \code{adjustCoords = TRUE}. 8 | #' @param imageIDs A list of IDs to match landmarks to images if landmarkList and imageList don't 9 | #' have the same length. 10 | #' 11 | #' @return X x Y x n array, where X and Y define the coordinates of the landmark points and n 12 | #' is the sample size. 13 | #' 14 | #' @examples 15 | #' 16 | #' \dontrun{ 17 | #' IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 18 | #' 19 | #' prepath <- system.file("extdata", package = 'patternize') 20 | #' extension <- '_landmarks_LFW.txt' 21 | #' 22 | #' landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 23 | #' 24 | #' landmarkArray <- lanArray(landmarkList) 25 | #' } 26 | #' 27 | #' @export 28 | 29 | 30 | lanArray <- function(sampleList, 31 | adjustCoords = FALSE, 32 | imageList = NULL, 33 | imageIDs = NULL){ 34 | 35 | # Make datastructure for Generailzed Procrustis Analysis 36 | for(n in 1:length(sampleList)){ 37 | 38 | print(paste('sample', n, names(sampleList)[n], 'added to array', sep=' ')) 39 | 40 | # Read in landmark files and build array for Morpho 41 | landmarks <- sampleList[[n]] 42 | 43 | 44 | if(adjustCoords){ 45 | if(is.null(imageList)){ 46 | stop('For adjusting landmarkcoordinates, you should supply the image list') 47 | } 48 | 49 | if(is.null(imageIDs)){ 50 | extPicture <- extent(imageList[[n]]) 51 | } 52 | if(!is.null(imageIDs)){ 53 | extPicture <- extent(imageList[[imageIDs[n]]]) 54 | } 55 | 56 | landmarks[,2] <- (extPicture[4]-landmarks[,2]) 57 | } 58 | 59 | if(n == 1){ 60 | landmarksArray <- array(dim=c(nrow(landmarks),2,1), data=landmarks) 61 | } 62 | else{ 63 | landmarksArray1 <- array(dim=c(nrow(landmarks),2,1), data=landmarks) 64 | landmarksArray <- abind::abind(landmarksArray,landmarksArray1,along=3) 65 | } 66 | } 67 | return(landmarksArray) 68 | } 69 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' @title imageList 2 | #' @description List of RasterStacks as returned by \code{makeList}. 3 | #' @format A list of 5 \code{RasterStack} objects of Heliconius erato hydara dorsal forewings. 4 | #' @examples 5 | #' \dontrun{ 6 | #' data(imageList) 7 | #' summary(imageList) 8 | #' } 9 | "imageList" 10 | 11 | #' @title landmarkList 12 | #' @description List of landmarks as returned by \code{makeList}. 13 | #' @format A list of landmarks for 5 Heliconius erato hydara dorsal forewings. 14 | #' @examples 15 | #' \dontrun{ 16 | #' data(landmarkList) 17 | #' summary(landmarkList) 18 | #' } 19 | "landmarkList" 20 | 21 | #' @title landmarkArray 22 | #' @description Array of landmarks as returned by \code{lanArray} and used by 23 | #' \code{link[Morpho]{procsym}}. 24 | #' @format An array of landmarks for 5 Heliconius erato hydara dorsal forewings. 25 | #' @examples 26 | #' \dontrun{ 27 | #' data(landmarkArray) 28 | #' summary(landmarkArray) 29 | #' } 30 | "landmarkArray" 31 | 32 | #' @title rasterList_lanRGB 33 | #' @description List of RasterLayers as returned by \code{patLanRGB}. 34 | #' @format A list of RasterLayers including the red color pattern extracted from 5 Heliconius 35 | #' erato hydara dorsal forewings using \code{patLanRGB}. 36 | #' @examples 37 | #' \dontrun{ 38 | #' data(rasterList_lanRGB) 39 | #' summary(rasterList_lanRGB) 40 | #' } 41 | "rasterList_lanRGB" 42 | 43 | #' @title rasterList_lanK 44 | #' @description List of RasterLayers as returned by \code{patLanK}. 45 | #' @format A list of RasterLayers including the red color pattern extracted from 5 Heliconius 46 | #' erato hydara dorsal forewings using \code{patLanK}. 47 | #' @examples 48 | #' \dontrun{ 49 | #' data(rasterList_lanK) 50 | #' summary(rasterList_lanL) 51 | #' } 52 | "rasterList_lanK" 53 | 54 | #' @title rasterList_regRGB 55 | #' @description List of RasterLayers as returned by \code{patRegRGB}. 56 | #' @format A list of RasterLayers including the red color pattern extracted from 5 Heliconius 57 | #' erato hydara dorsal forewings using \code{patRegRGB}. 58 | #' @examples 59 | #' \dontrun{ 60 | #' data(rasterList_regRGB) 61 | #' summary(rasterList_regRGB) 62 | #' } 63 | "rasterList_regRGB" 64 | 65 | #' @title rasterList_regK 66 | #' @description List of RasterLayers as returned by \code{patRegK}. 67 | #' @format A list of RasterLayers including the red color pattern extracted from 5 Heliconius 68 | #' erato hydara dorsal forewings using \code{patRegK}. 69 | #' @examples 70 | #' \dontrun{ 71 | #' data(rasterList_regK) 72 | #' summary(rasterList_regK) 73 | #' } 74 | "rasterList_regK" 75 | -------------------------------------------------------------------------------- /man/maskOutline.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/maskOutline.R 3 | \name{maskOutline} 4 | \alias{maskOutline} 5 | \title{Intersects a RasterStack with an outline. Everything outside of the outline will be removed 6 | from the raster.} 7 | \usage{ 8 | maskOutline( 9 | RasterStack, 10 | outline, 11 | refShape, 12 | landList = NULL, 13 | adjustCoords = FALSE, 14 | cartoonID = NULL, 15 | IDlist = NULL, 16 | crop = c(0, 0, 0, 0), 17 | flipRaster = NULL, 18 | flipOutline = NULL, 19 | imageList = NULL, 20 | maskColor = 0, 21 | inverse = FALSE 22 | ) 23 | } 24 | \arguments{ 25 | \item{RasterStack}{RasterStack to be masked.} 26 | 27 | \item{outline}{xy coordinates that define outline.} 28 | 29 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 30 | registration analysis) or 'mean' if the images were transformed to a mean shape (only 31 | for meanshape when using landmark transformation)} 32 | 33 | \item{landList}{Landmark list to be given when type = 'mean'.} 34 | 35 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to 36 | pixel coordinates (default = FALSE).} 37 | 38 | \item{cartoonID}{ID of the sample for which the cartoon was drawn. Only has to be given when 39 | refShape is 'mean'.} 40 | 41 | \item{IDlist}{List of sample IDs should be specified when refShape is 'mean'.} 42 | 43 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to 44 | crop the original image used in landmark or registration analysis.} 45 | 46 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency 47 | between raster and outline coordinates).} 48 | 49 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 50 | 51 | \item{imageList}{List of image as obtained from \code{\link[patternize]{makeList}} should 52 | be given if one wants to flip the outline or adjust landmark coordinates.} 53 | 54 | \item{maskColor}{Color the masked area gets. Set to 0 for black (default) or 255 for white.} 55 | 56 | \item{inverse}{If TRUE, areas withing the outline will be masked.} 57 | } 58 | \description{ 59 | Intersects a RasterStack with an outline. Everything outside of the outline will be removed 60 | from the raster. 61 | } 62 | \examples{ 63 | 64 | \dontrun{ 65 | data(imageList) 66 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 67 | '/BC0077_outline.txt', sep=''), header = FALSE) 68 | 69 | masked <- maskOutline(imageList[[1]], outline_BC0077, refShape = 'target', flipOutline = 'y') 70 | } 71 | 72 | } 73 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(GMMImage) 4 | export(alignLan) 5 | export(alignReg) 6 | export(colorChecker) 7 | export(colorChecker_customGray) 8 | export(colorChecker_half) 9 | export(createPhenotype) 10 | export(createTarget) 11 | export(kImage) 12 | export(kImageHSV) 13 | export(lanArray) 14 | export(makeList) 15 | export(maskOutline) 16 | export(patArea) 17 | export(patGMM) 18 | export(patK) 19 | export(patK_HSV) 20 | export(patLanHSV) 21 | export(patLanK) 22 | export(patLanK_HSV) 23 | export(patLanRGB) 24 | export(patLanW) 25 | export(patPCA) 26 | export(patRDA) 27 | export(patRegHSV) 28 | export(patRegK) 29 | export(patRegK_HSV) 30 | export(patRegRGB) 31 | export(patRegW) 32 | export(plotHeat) 33 | export(plotRasterstackAsImage) 34 | export(redRes) 35 | export(sampleLandmarks) 36 | export(sampleRGB) 37 | export(setMask) 38 | export(sumRaster) 39 | import(raster) 40 | import(sf) 41 | import(vegan) 42 | importFrom(ClusterR,GMM) 43 | importFrom(ClusterR,predict_GMM) 44 | importFrom(Morpho,applyTransform) 45 | importFrom(Morpho,computeTransform) 46 | importFrom(Morpho,procSym) 47 | importFrom(dplyr,sample_n) 48 | importFrom(geomorph,readland.tps) 49 | importFrom(grDevices,adjustcolor) 50 | importFrom(grDevices,col2rgb) 51 | importFrom(grDevices,colorRampPalette) 52 | importFrom(grDevices,dev.off) 53 | importFrom(grDevices,hsv) 54 | importFrom(grDevices,png) 55 | importFrom(grDevices,rgb) 56 | importFrom(grDevices,rgb2hsv) 57 | importFrom(graphics,layout) 58 | importFrom(graphics,locator) 59 | importFrom(graphics,mtext) 60 | importFrom(graphics,par) 61 | importFrom(graphics,points) 62 | importFrom(graphics,polygon) 63 | importFrom(imager,B) 64 | importFrom(imager,G) 65 | importFrom(imager,R) 66 | importFrom(imager,add) 67 | importFrom(imager,as.cimg) 68 | importFrom(imager,bucketfill) 69 | importFrom(imager,clean) 70 | importFrom(imager,enorm) 71 | importFrom(imager,height) 72 | importFrom(imager,highlight) 73 | importFrom(imager,imfill) 74 | importFrom(imager,imgradient) 75 | importFrom(imager,imsplit) 76 | importFrom(imager,imsub) 77 | importFrom(imager,isoblur) 78 | importFrom(imager,load.image) 79 | importFrom(imager,parany) 80 | importFrom(imager,resize) 81 | importFrom(imager,save.image) 82 | importFrom(imager,split_connected) 83 | importFrom(imager,watershed) 84 | importFrom(imager,width) 85 | importFrom(magrittr,"%>%") 86 | importFrom(methods,is) 87 | importFrom(purrr,discard) 88 | importFrom(sp,Polygons) 89 | importFrom(sp,SpatialPolygons) 90 | importFrom(sp,SpatialPolygonsDataFrame) 91 | importFrom(stats,kmeans) 92 | importFrom(stats,lm) 93 | importFrom(stats,na.omit) 94 | importFrom(stats,prcomp) 95 | importFrom(stats,var) 96 | importFrom(utils,capture.output) 97 | importFrom(utils,read.table) 98 | importFrom(utils,write.table) 99 | -------------------------------------------------------------------------------- /man/alignLan.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/alignLan.R 3 | \name{alignLan} 4 | \alias{alignLan} 5 | \title{Align images using landmarks} 6 | \usage{ 7 | alignLan( 8 | imageList, 9 | landList, 10 | IDlist = NULL, 11 | adjustCoords = FALSE, 12 | resampleFactor = NULL, 13 | res = c(300, 300), 14 | transformRef = "meanshape", 15 | transformType = "tps", 16 | maskOutline = NULL, 17 | removebg = NULL, 18 | removebgColOffset = 0.1, 19 | inverse = FALSE, 20 | cartoonID = NULL, 21 | refImage = NULL, 22 | plotTransformed = FALSE, 23 | format = "imageJ" 24 | ) 25 | } 26 | \arguments{ 27 | \item{imageList}{List of RasterStack objects.} 28 | 29 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 30 | 31 | \item{IDlist}{List of sample IDs should be specified when masking outline and transformRef 32 | is 'meanshape'.} 33 | 34 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 35 | coordinates (default = FALSE).} 36 | 37 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 38 | 39 | \item{res}{Resolution vector c(x,y) for output rasters (default = c(300,300)). This should be 40 | reduced if the number of pixels in the image is lower than th raster.} 41 | 42 | \item{transformRef}{ID or landmark matrix of reference sample for shape to which color patterns 43 | will be transformed to. Can be 'meanshape' for transforming to mean shape of Procrustes 44 | analysis.} 45 | 46 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 47 | (default ='tps').} 48 | 49 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 50 | the color extraction (default = NULL). This can be a list of multiple outlines.} 51 | 52 | \item{removebg}{Integer or RGB vector indicating the range of RGB threshold to remove from 53 | image (e.g. 100 removes pixels with average RGB > 100; default = NULL).} 54 | 55 | \item{removebgColOffset}{Color offset for color background extraction (default = 0.10).} 56 | 57 | \item{inverse}{If TRUE, areas withing the outline will be masked. If maskOutline is a list, this 58 | should also be a list.} 59 | 60 | \item{cartoonID}{ID of the sample for which the cartoon was drawn and will be used for masking 61 | (should be set when transformRef = 'meanShape').} 62 | 63 | \item{refImage}{Image (RasterStack) used for target. Use raster::stack('filename').} 64 | 65 | \item{plotTransformed}{Plot transformed image (default = FALSE).} 66 | 67 | \item{format}{ImageJ (Fiji) or tps format (default = 'imageJ').} 68 | } 69 | \value{ 70 | List of aligned RasterStack objects. 71 | } 72 | \description{ 73 | Align images using landmarks 74 | } 75 | -------------------------------------------------------------------------------- /R/sampleRGB.R: -------------------------------------------------------------------------------- 1 | #' Interactive function to sample RGB value from pixel or square area in an image. 2 | #' 3 | #' @param image Image imported as a RasterStack. 4 | #' @param resampleFactor Integer for downsampling used by \code{\link{redRes}}. 5 | #' @param crop Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 6 | #' original image. 7 | #' @param type Set 'point' to extract RGB from a single point or 'area' to extract from a square 8 | #' area defined by setting two points (default = 'point'). 9 | #' 10 | #' @return RGB vector 11 | #' 12 | #' @examples 13 | #' image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 14 | #' RGB <- sampleRGB(image, resampleFactor = 1) 15 | #' 16 | #' @export 17 | #' @import raster 18 | #' @importFrom imager as.cimg imsub 19 | #' @importFrom graphics locator 20 | 21 | sampleRGB <- function(image, 22 | resampleFactor = NULL, 23 | crop = c(0,0,0,0), 24 | type = 'point'){ 25 | 26 | # Reduce resolution 27 | if(!is.null(resampleFactor)){ 28 | 29 | image <- redRes(image, resampleFactor) 30 | } 31 | 32 | # Crop image 33 | if(!identical(crop, c(0,0,0,0))){ 34 | 35 | rasterExt <- crop 36 | image <- raster::crop(image, rasterExt) 37 | } 38 | 39 | # Transform to imager format 40 | imA <- raster::as.array(image) 41 | imA[is.na(imA[])] <- 0 42 | imR <- as.raster(imA, nrow = dim(image)[1], ncol = dim(image)[2], max = 255) 43 | im <- imager::as.cimg(imR) 44 | 45 | plot(im) 46 | 47 | if(type == 'point'){ 48 | 49 | # Pick pixel and return RGB 50 | print("Choose a point for which you want RGB values.") 51 | 52 | xy <- locator(n=1) 53 | 54 | print(paste('x: ', as.character(xy)[1], 'y: ', as.character(xy)[2])) 55 | 56 | RGB <- as.vector(imager::imsub(im,x = xy$x,y = xy$y)) 57 | 58 | print(paste(c('RGB: ', RGB), collapse = ' ')) 59 | } 60 | 61 | if(type == 'area'){ 62 | 63 | print("Choose two points to define square area for which you want RGB values.") 64 | 65 | xy1 <- locator(n=1) 66 | 67 | print(paste('x: ', as.character(xy1)[1], 'y: ', as.character(xy1)[2])) 68 | 69 | xy2 <- locator(n=1) 70 | 71 | print(paste('x: ', as.character(xy2)[1], 'y: ', as.character(xy2)[2])) 72 | 73 | xy <- as.matrix(rbind(as.numeric(as.character(xy1)),as.numeric(as.character(xy2)))) 74 | 75 | minX <- min(xy[,1]) 76 | maxX <- max(xy[,1]) 77 | minY <- min(xy[,2]) 78 | maxY <- max(xy[,2]) 79 | 80 | x <- 0 # Otherwis R CMD check returns note for imsub function 81 | y <- 0 82 | 83 | imS <- as.array(imager::imsub(im, x %in% c(round(minX,0):round(maxX,0)), y %in% c(round(minY,0):round(maxY,0)))) 84 | 85 | R <- mean(imS[,,1,1]) 86 | G <- mean(imS[,,1,2]) 87 | B <- mean(imS[,,1,3]) 88 | 89 | RGB <- c(R,G,B) 90 | 91 | print(paste(c('RGB: ', RGB), collapse = ' ')) 92 | 93 | } 94 | 95 | return(RGB) 96 | } 97 | -------------------------------------------------------------------------------- /man/patRegK.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRegK.R 3 | \name{patRegK} 4 | \alias{patRegK} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 6 | and extracts colors using k-means clustering.} 7 | \usage{ 8 | patRegK( 9 | sampleList, 10 | target, 11 | k = 3, 12 | fixedStartCenter = NULL, 13 | resampleFactor = NULL, 14 | useBlockPercentage = 75, 15 | crop = c(0, 0, 0, 0), 16 | removebgR = NULL, 17 | removebgK = NULL, 18 | maskOutline = NULL, 19 | maskColor = 0, 20 | plot = FALSE, 21 | focal = FALSE, 22 | sigma = 3 23 | ) 24 | } 25 | \arguments{ 26 | \item{sampleList}{List of RasterStack objects.} 27 | 28 | \item{target}{Image imported as RasterStack used as target for registration.} 29 | 30 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 31 | 32 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 33 | 34 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}} (default = NULL).} 35 | 36 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 37 | (default = 75).} 38 | 39 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 40 | original image.} 41 | 42 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 43 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 44 | remove a white background.} 45 | 46 | \item{removebgK}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 47 | pixels with average RGB > 100; default = NULL) for k-means analysis. This works only to remove 48 | a white background.} 49 | 50 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 51 | the color extraction (default = NULL).} 52 | 53 | \item{maskColor}{Color the masked area gets. Set to 0 for black (default) or 255 for white.} 54 | 55 | \item{plot}{Whether to plot k-means clustered image while processing (default = FALSE).} 56 | 57 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 58 | 59 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 60 | } 61 | \value{ 62 | List of rasters for each k-means cluster objects. 63 | } 64 | \description{ 65 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 66 | and extracts colors using k-means clustering. 67 | } 68 | \examples{ 69 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 70 | prepath <- system.file("extdata", package = 'patternize') 71 | extension <- '.jpg' 72 | 73 | imageList <- makeList(IDlist, 'image', prepath, extension) 74 | 75 | target <- imageList[[1]] 76 | 77 | \dontrun{ 78 | rasterList_regK <- patRegK(imageList[3], target, k = 5, 79 | crop = c(100,400,40,250), removebgR = 100, plot = TRUE) 80 | } 81 | 82 | } 83 | -------------------------------------------------------------------------------- /R/sumRaster.R: -------------------------------------------------------------------------------- 1 | #' This function sums the individual color pattern RasterLayes as obtained by the main patternize 2 | #' functions. 3 | #' 4 | #' @param rList List of RasterLayers or list of RasterLayers for each k-means cluster. 5 | #' @param IDlist List of sample IDs. 6 | #' @param type Type of rasterlist; 'RGB' or 'k' (result from RGB or k-means analysis, respectively). 7 | #' 8 | #' @examples 9 | #' data(rasterList_lanRGB) 10 | #' IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 11 | #' summedRaster <- sumRaster(rasterList_lanRGB, IDlist, type = 'RGB') 12 | #' 13 | #' data(rasterList_lanK) 14 | #' IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 15 | #' summedRasterList <- sumRaster(rasterList_lanK, IDlist, type = 'k') 16 | #' 17 | #' @export 18 | 19 | sumRaster <- function(rList, 20 | IDlist, 21 | type){ 22 | 23 | subRasterList <- list() 24 | 25 | for(e in 1:length(IDlist)){ 26 | 27 | subRasterList[[IDlist[e]]] <- rList[[IDlist[e]]] 28 | 29 | } 30 | 31 | if(type == 'RGB'){ 32 | 33 | for(e in 1:length(IDlist)){ 34 | 35 | if(!identical(raster::extent(subRasterList[[IDlist[e]]]), raster::extent(subRasterList[[1]]))){ 36 | 37 | print(paste('raster extent set to extent of rasterLayer 1 in IDlist for sample', IDlist[e], sep=' ')) 38 | raster::extent(subRasterList[[IDlist[e]]]) <- raster::extent(subRasterList[[1]]) 39 | } 40 | } 41 | 42 | names(subRasterList) <- NULL 43 | subRasterList$fun <- sum 44 | subRasterList$na.rm <- TRUE 45 | summedRaster <- do.call(mosaic,subRasterList) 46 | 47 | return(summedRaster) 48 | 49 | } 50 | 51 | if(type == 'k'){ 52 | 53 | rasterListList <- list() 54 | 55 | for(n in 1:length(subRasterList)){ 56 | 57 | sample <- subRasterList[[n]] 58 | 59 | for(e in 1:length(sample)){ 60 | 61 | if(n == 1){ 62 | 63 | rasterListList[[e]] <- c(sample[[e]]) 64 | 65 | } 66 | 67 | else{ 68 | 69 | rasterListList[[e]] <- c(rasterListList[[e]], sample[[e]]) 70 | 71 | } 72 | } 73 | } 74 | 75 | summedRasterList <- list() 76 | 77 | for(k in 1:length(rasterListList)){ 78 | 79 | for(e in 1:length(IDlist)){ 80 | 81 | if(!identical(raster::extent(rasterListList[[k]][[e]]), raster::extent(rasterListList[[k]][[1]]))){ 82 | 83 | print(paste('raster extent set to extent of rasterLayer 1 in IDlist for cluster', k , 'in sample', IDlist[e], sep=' ')) 84 | raster::extent(rasterListList[[k]][[e]]) <- raster::extent(rasterListList[[k]][[1]]) 85 | } 86 | } 87 | 88 | names(rasterListList[[k]]) <- NULL 89 | rasterListList[[k]]$fun <- sum 90 | rasterListList[[k]]$na.rm <- TRUE 91 | summedRaster <- do.call(mosaic,rasterListList[[k]]) 92 | 93 | summedRasterList[[k]] <- summedRaster 94 | 95 | } 96 | 97 | return(summedRasterList) 98 | 99 | } 100 | 101 | 102 | } 103 | -------------------------------------------------------------------------------- /man/patRegK_HSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRegK_HSV.R 3 | \name{patRegK_HSV} 4 | \alias{patRegK_HSV} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 6 | and extracts colors using k-means clustering.} 7 | \usage{ 8 | patRegK_HSV( 9 | sampleList, 10 | target, 11 | k = 3, 12 | fixedStartCenter = NULL, 13 | resampleFactor = NULL, 14 | useBlockPercentage = 75, 15 | crop = c(0, 0, 0, 0), 16 | removebgR = NULL, 17 | removebgK = NULL, 18 | maskOutline = NULL, 19 | maskColor = 0, 20 | plot = FALSE, 21 | focal = FALSE, 22 | sigma = 3, 23 | ignoreHSVvalue = FALSE 24 | ) 25 | } 26 | \arguments{ 27 | \item{sampleList}{List of RasterStack objects.} 28 | 29 | \item{target}{Image imported as RasterStack used as target for registration.} 30 | 31 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 32 | 33 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 34 | 35 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}} (default = NULL).} 36 | 37 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 38 | (default = 75).} 39 | 40 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 41 | original image.} 42 | 43 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 44 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 45 | remove a white background.} 46 | 47 | \item{removebgK}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 48 | pixels with average RGB > 100; default = NULL) for k-means analysis. This works only to remove 49 | a white background.} 50 | 51 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 52 | the color extraction (default = NULL).} 53 | 54 | \item{maskColor}{Color the masked area gets. Set to 0 for black (default) or 255 for white.} 55 | 56 | \item{plot}{Whether to plot k-means clustered image while processing (default = FALSE).} 57 | 58 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 59 | 60 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 61 | 62 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 63 | } 64 | \value{ 65 | List of rasters for each k-means cluster objects. 66 | } 67 | \description{ 68 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 69 | and extracts colors using k-means clustering. 70 | } 71 | \examples{ 72 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 73 | prepath <- system.file("extdata", package = 'patternize') 74 | extension <- '.jpg' 75 | 76 | imageList <- makeList(IDlist, 'image', prepath, extension) 77 | 78 | target <- imageList[[1]] 79 | 80 | \dontrun{ 81 | rasterList_regK <- patRegK(imageList[3], target, k = 5, 82 | crop = c(100,400,40,250), removebgR = 100, plot = TRUE) 83 | } 84 | 85 | } 86 | -------------------------------------------------------------------------------- /R/createTarget.R: -------------------------------------------------------------------------------- 1 | #' Create a target image (RasterStack) from a polygon. 2 | #' 3 | #' @param outline xy coordinates that define outline. 4 | #' @param image Image imported as RasterStack used in the analysis. This is used to extract 5 | #' the extent and dimensions for the raster layers. 6 | #' @param res Resolution for RasterStack (default = 300). 7 | #' @param colorFill Color for the fill of the polygon (default = 'black'). 8 | #' @param colorBG Color for the background (default = 'white'). 9 | #' @param sigma Size of sigma for Gaussian blurring (default = 10). 10 | #' @param plot Whether to plot the created target image (default = FALSE). 11 | #' 12 | #' @return RasterStack 13 | #' 14 | #' @examples 15 | #' 16 | #' \dontrun{ 17 | #' outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 18 | #' '/BC0077_outline.txt', sep=''), header = FALSE) 19 | #' 20 | #' data(imageList) 21 | #' 22 | #' target <- createTarget(outline_BC0077, imageList[[1]], plot = TRUE) 23 | #' } 24 | #' 25 | #' @export 26 | #' @import raster 27 | #' @importFrom grDevices col2rgb rgb 28 | 29 | createTarget <- function(outline, 30 | image, 31 | res = 300, 32 | colorFill = 'black', 33 | colorBG = 'white', 34 | sigma = 10, 35 | plot = FALSE){ 36 | 37 | if(is.character(colorFill)){ 38 | colorFill <- col2rgb(colorFill) 39 | } 40 | 41 | if(is.character(colorBG)){ 42 | colorBG <- col2rgb(colorBG) 43 | } 44 | 45 | rasterEx <- raster::extent(image) 46 | 47 | outline[,2] <- rasterEx[4] - outline[,2] 48 | 49 | poly <- sp::Polygons(list(sp::Polygon(outline)),paste("r")) 50 | 51 | polyList <- c(poly) 52 | polyNames <- c(paste("r")) 53 | sr=sp::SpatialPolygons(polyList) 54 | srdf=sp::SpatialPolygonsDataFrame(sr, data.frame(1:length(polyNames), row.names=polyNames)) 55 | 56 | r <- raster::raster(rasterEx, nrow = res, ncol = res) 57 | 58 | print('making raster layers') 59 | rr1 <-raster::rasterize(srdf, r, colorFill[1], background = colorBG[1]) 60 | print('rasterized layer 1/3') 61 | rr2 <-raster::rasterize(srdf, r, colorFill[2], background = colorBG[2]) 62 | print('rasterized layer 2/3') 63 | rr3 <-raster::rasterize(srdf, r, colorFill[3], background = colorBG[3]) 64 | print('rasterized layer 3/3') 65 | 66 | gf <- focalWeight(r, sigma, "Gauss") 67 | 68 | rrr1 <- raster::focal(rr1, gf) 69 | rrr2 <- raster::focal(rr2, gf) 70 | rrr3 <- raster::focal(rr3, gf) 71 | 72 | rr <- raster::stack(rrr1, rrr2, rrr3) 73 | rr[is.na(rr)] <- 255 74 | 75 | if(plot){ 76 | print('making plot...') 77 | x <- as.array(rr)/255 78 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 79 | uniqueCols <- unique(cols) 80 | x2 <- match(cols, uniqueCols) 81 | dim(x2) <- dim(x)[1:2] 82 | raster::image(t(apply(x2,2,rev)), col=uniqueCols,yaxt='n', xaxt='n') 83 | } 84 | 85 | print('resampling raster') 86 | r2 <- raster::raster(rasterEx, nrow=dim(image)[1], ncol=dim(image)[2]) 87 | rrr <- raster::resample(rr,r2, datatype="INT1U", method='ngb') 88 | 89 | print('done') 90 | 91 | return(rrr) 92 | } 93 | -------------------------------------------------------------------------------- /R/makeList.R: -------------------------------------------------------------------------------- 1 | #' Build list of landmarks or RasterStacks from images using filepath and file extension. 2 | #' 3 | #' @param IDlist List of sample IDs. 4 | #' @param type 'landmark' or 'image' depending on what type of list to make. 5 | #' @param prepath Prepath (default = NULL). 6 | #' @param extension Extension (default = NULL). 7 | #' @param format ImageJ (Fiji) or tps format (default = 'imageJ'). 8 | #' @param tpsFile Provide filename of tps file ff format is 'tps'. 9 | #' @param skipLandmark Vector of rownumbers of landmarks to skip. 10 | #' 11 | #' @return Landmark or RasterStack list. 12 | #' 13 | #' @examples 14 | #' IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 15 | #' 16 | #' prepath <- system.file("extdata", package = 'patternize') 17 | #' extension <- '_landmarks_LFW.txt' 18 | #' 19 | #' landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 20 | #' 21 | #' extension <- '.jpg' 22 | #' imageList <- makeList(IDlist, 'image', prepath, extension) 23 | #' 24 | #' @export 25 | #' @importFrom utils read.table 26 | #' @importFrom geomorph readland.tps 27 | 28 | makeList <- function(IDlist, 29 | type, 30 | prepath = NULL, 31 | extension = NULL, 32 | format = 'imageJ', 33 | tpsFile = NULL, 34 | skipLandmark = NULL){ 35 | 36 | objectList <- list() 37 | 38 | if(!is.null(skipLandmark)){ 39 | skipLandmark <- -1*skipLandmark 40 | } 41 | 42 | for(n in 1:length(IDlist)){ 43 | 44 | if(format == 'imageJ'){ 45 | print(paste('sample', n, IDlist[n], 'added to list', sep=' ')) 46 | 47 | if(type == 'landmark'){ 48 | 49 | if(is.null(prepath)){ 50 | landmarks <- read.table(paste(IDlist[n], extension, sep=''), header = FALSE, 51 | stringsAsFactors = FALSE, colClasses = c('numeric', 'numeric')) 52 | } 53 | else{ 54 | landmarks <- read.table(paste(prepath,'/',IDlist[n], extension, sep=''), header = FALSE, 55 | stringsAsFactors = FALSE, colClasses = c('numeric', 'numeric')) 56 | } 57 | 58 | landmarks <- as.matrix(landmarks) 59 | colnames(landmarks) <- NULL 60 | 61 | if(!is.null(skipLandmark)){ 62 | landmarks <- landmarks[skipLandmark,] 63 | } 64 | 65 | objectList[[IDlist[n]]] <- landmarks 66 | } 67 | } 68 | 69 | 70 | if(type == 'image'){ 71 | 72 | if(is.null(prepath)){ 73 | suppressWarnings(image <- raster::stack(paste(IDlist[n], extension, sep=''))) 74 | crs(image) <- sp::CRS('+init=EPSG:4326') 75 | } 76 | else{ 77 | suppressWarnings(image <- raster::stack(paste(prepath,'/',IDlist[n], extension, sep=''))) 78 | crs(image) <- sp::CRS('+init=EPSG:4326') 79 | } 80 | 81 | objectList[[IDlist[n]]] <- image 82 | } 83 | } 84 | 85 | if(all(c(type == 'landmark', format == 'tps'))){ 86 | 87 | objectListX <- readland.tps(tpsFile, specID = 'imageID', warnmsg = FALSE) 88 | objectList <- lapply(1:dim(objectListX)[3],function(i) objectListX[,,i]) 89 | names(objectList) <- IDlist 90 | } 91 | 92 | return(objectList) 93 | } 94 | 95 | 96 | -------------------------------------------------------------------------------- /man/createPhenotype.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/createPhenotype.R 3 | \name{createPhenotype} 4 | \alias{createPhenotype} 5 | \title{Plot color pattern prediction for specified PCA values} 6 | \usage{ 7 | createPhenotype( 8 | PCAdata, 9 | PCApredict, 10 | IDlist, 11 | rasterList, 12 | colpalette = NULL, 13 | plotCartoon = FALSE, 14 | refShape = NULL, 15 | outline = NULL, 16 | lines = NULL, 17 | landList = NULL, 18 | adjustCoords = FALSE, 19 | cartoonID = NULL, 20 | normalized = TRUE, 21 | crop = c(0, 0, 0, 0), 22 | flipRaster = NULL, 23 | flipOutline = NULL, 24 | imageList = NULL, 25 | cartoonOrder = "above", 26 | lineOrder = "above", 27 | cartoonCol = "gray", 28 | cartoonFill = NULL, 29 | legendTitle = "Proportion", 30 | zlim = NULL 31 | ) 32 | } 33 | \arguments{ 34 | \item{PCAdata}{Output of PCA analysis. List item 3 of patPCA.} 35 | 36 | \item{PCApredict}{A vector with the PCA values for which to predict the phenotype. This vector 37 | only needs to include the values upto the last PCA axis to predict along, other values are 38 | set to zero.} 39 | 40 | \item{IDlist}{List of sample IDs.} 41 | 42 | \item{rasterList}{rasterList used for PCA.} 43 | 44 | \item{colpalette}{Vector of colors for color palette 45 | (default = c("white","lightblue","blue","green", "yellow","red"))} 46 | 47 | \item{plotCartoon}{Whether to plot a cartoon. This cartoon should be drawn on one of the samples 48 | used in the analysis.} 49 | 50 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 51 | registration analysis) or 'mean' if the images were transformed to a mean shape (only for 52 | meanshape when using landmark transformation)} 53 | 54 | \item{outline}{xy coordinates that define outline.} 55 | 56 | \item{lines}{list of files with xy coordinates of line objects to be added to cartoon.} 57 | 58 | \item{landList}{Landmark landmarkList.} 59 | 60 | \item{adjustCoords}{Adjust landmark coordinates.} 61 | 62 | \item{cartoonID}{ID of the sample for which the cartoon was drawn.} 63 | 64 | \item{normalized}{Set this to true in case the summed rasters are already devided by the 65 | sample number.} 66 | 67 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop 68 | the original image used in landmark or registration analysis.} 69 | 70 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency 71 | between raster and outline coordinates).} 72 | 73 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 74 | 75 | \item{imageList}{List of images should be given if one wants to flip the outline or adjust 76 | landmark coordinates.} 77 | 78 | \item{cartoonOrder}{Whether to plot the cartoon outline 'above' or 'under' the pattern raster 79 | (default = 'above'). Set to 'under' for filled outlines.} 80 | 81 | \item{lineOrder}{Whether to plot the cartoon lines 'above' or 'under' the pattern raster 82 | (default = 'above').} 83 | 84 | \item{cartoonCol}{Outline and line color for cartoon (deafault = 'gray').} 85 | 86 | \item{cartoonFill}{Fill color for outline of cartoon (default = NULL).} 87 | 88 | \item{legendTitle}{Title of the raster legend (default = 'Proportion').} 89 | 90 | \item{zlim}{zlim values for predicted pattern.} 91 | } 92 | \description{ 93 | Plot color pattern prediction for specified PCA values 94 | } 95 | -------------------------------------------------------------------------------- /man/patRegRGB.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRegRGB.R 3 | \name{patRegRGB} 4 | \alias{patRegRGB} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 6 | and extracts colors using a predefined RGB values and cutoff value.} 7 | \usage{ 8 | patRegRGB( 9 | sampleList, 10 | target, 11 | RGB, 12 | resampleFactor = NULL, 13 | useBlockPercentage = 75, 14 | colOffset = 0.1, 15 | crop = c(0, 0, 0, 0), 16 | removebgR = NULL, 17 | maskOutline = NULL, 18 | plot = FALSE, 19 | focal = FALSE, 20 | sigma = 3, 21 | iterations = 0, 22 | patternsToFile = NULL 23 | ) 24 | } 25 | \arguments{ 26 | \item{sampleList}{List of RasterStack objects.} 27 | 28 | \item{target}{Image imported as RasterStack used as target for registration.} 29 | 30 | \item{RGB}{Values for color pattern extraction specified as RGB vector.} 31 | 32 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}} (default = NULL).} 33 | 34 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 35 | (default = 75).} 36 | 37 | \item{colOffset}{Color offset for color pattern extraction (default = 0.10).} 38 | 39 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 40 | original image.} 41 | 42 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 43 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 44 | remove a white background.} 45 | 46 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 47 | the color extraction (default = NULL).} 48 | 49 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE). 50 | Transformed color patterns can be plot on top of each other ('stack') or next to the 51 | original image for each sample ('compare').} 52 | 53 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 54 | 55 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 56 | 57 | \item{iterations}{Number of iterations for recalculating average color (default = 0). If set, the 58 | RGB value for pattern extraction will be iteratively recalculated to be the average of the 59 | extracted area. This may improve extraction of distinct color pattern, but fail for more 60 | gradually distributed (in color space) patterns.} 61 | 62 | \item{patternsToFile}{Name of directory to which the color pattern of each individual will be 63 | outputted (default = NULL).} 64 | } 65 | \value{ 66 | List of raster objects. 67 | } 68 | \description{ 69 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 70 | and extracts colors using a predefined RGB values and cutoff value. 71 | } 72 | \examples{ 73 | \dontrun{ 74 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 75 | prepath <- system.file("extdata", package = 'patternize') 76 | extension <- '.jpg' 77 | 78 | imageList <- makeList(IDlist, 'image', prepath, extension) 79 | 80 | target <- imageList[[1]] 81 | 82 | RGB <- c(114,17,0) 83 | 84 | # Note that this example only aligns one image with the target, 85 | # remove [2] to run a full examples. 86 | rasterList_regRGB <- patRegRGB(imageList[2], target, RGB, 87 | colOffset= 0.15, crop = c(100,400,40,250), removebgR = 100, plot = 'stack') 88 | } 89 | 90 | } 91 | -------------------------------------------------------------------------------- /man/patRegHSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRegHSV.R 3 | \name{patRegHSV} 4 | \alias{patRegHSV} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 6 | and extracts colors using a predefined HSV values and cutoff value.} 7 | \usage{ 8 | patRegHSV( 9 | sampleList, 10 | target, 11 | HSV, 12 | resampleFactor = NULL, 13 | useBlockPercentage = 75, 14 | colOffset = 0.1, 15 | crop = c(0, 0, 0, 0), 16 | removebgR = NULL, 17 | maskOutline = NULL, 18 | plot = FALSE, 19 | focal = FALSE, 20 | sigma = 3, 21 | iterations = 0, 22 | ignoreHSVvalue = FALSE, 23 | patternsToFile = NULL 24 | ) 25 | } 26 | \arguments{ 27 | \item{sampleList}{List of RasterStack objects.} 28 | 29 | \item{target}{Image imported as RasterStack used as target for registration.} 30 | 31 | \item{HSV}{Values for color pattern extraction specified as HSV vector.} 32 | 33 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}} (default = NULL).} 34 | 35 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 36 | (default = 75).} 37 | 38 | \item{colOffset}{Color offset for color pattern extraction (default = 0.10).} 39 | 40 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 41 | original image.} 42 | 43 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 44 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 45 | remove a white background.} 46 | 47 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 48 | the color extraction (default = NULL).} 49 | 50 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE). 51 | Transformed color patterns can be plot on top of each other ('stack') or next to the 52 | original image for each sample ('compare').} 53 | 54 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 55 | 56 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 57 | 58 | \item{iterations}{Number of iterations for recalculating average color (default = 0). If set, the 59 | RGB value for pattern extraction will be iteratively recalculated to be the average of the 60 | extracted area. This may improve extraction of distinct color pattern, but fail for more 61 | gradually distributed (in color space) patterns.} 62 | 63 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 64 | 65 | \item{patternsToFile}{Name of directory to which the color pattern of each individual will be 66 | outputted (default = NULL).} 67 | } 68 | \value{ 69 | List of raster objects. 70 | } 71 | \description{ 72 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 73 | and extracts colors using a predefined HSV values and cutoff value. 74 | } 75 | \examples{ 76 | \dontrun{ 77 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 78 | prepath <- system.file("extdata", package = 'patternize') 79 | extension <- '.jpg' 80 | 81 | imageList <- makeList(IDlist, 'image', prepath, extension) 82 | 83 | target <- imageList[[1]] 84 | 85 | HSV <- c(0.025,1,0.45) 86 | 87 | # Note that this example only aligns one image with the target, 88 | # remove [2] to run a full examples. 89 | rasterList_regHSV <- patRegRGB(imageList[2], target, HSV, 90 | colOffset= 0.15, crop = c(100,400,40,250), removebgR = 100, plot = 'stack') 91 | } 92 | 93 | } 94 | -------------------------------------------------------------------------------- /man/patLanK.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patLanK.R 3 | \name{patLanK} 4 | \alias{patLanK} 5 | \title{Aligns images usings transformations obtained from fixed landmarks and extracts colors using 6 | k-means clustering.} 7 | \usage{ 8 | patLanK( 9 | sampleList, 10 | landList, 11 | k = 3, 12 | fixedStartCenter = NULL, 13 | resampleFactor = NULL, 14 | crop = FALSE, 15 | cropOffset = c(0, 0, 0, 0), 16 | res = 300, 17 | transformRef = "meanshape", 18 | transformType = "tps", 19 | removebg = NULL, 20 | removebgColOffset = 0.1, 21 | adjustCoords = FALSE, 22 | plot = FALSE, 23 | focal = FALSE, 24 | sigma = 3 25 | ) 26 | } 27 | \arguments{ 28 | \item{sampleList}{List of RasterStack objects.} 29 | 30 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 31 | 32 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 33 | 34 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 35 | 36 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 37 | 38 | \item{crop}{Whether to use the landmarks range to crop the image. This can significantly speed 39 | up the analysis (default = FALSE).} 40 | 41 | \item{cropOffset}{Vector c(xmin, xmax, ymin, ymax) that specifies the number of pixels you 42 | want the cropping to be offset from the landmarks (in case the landmarks do not surround 43 | the entire color pattern). The values specified should present the percentage of the maximum 44 | landmark value along the x and y axis.} 45 | 46 | \item{res}{Resolution for color pattern raster (default = 300). This should be reduced if the 47 | number of pixels in the image is lower than th raster.} 48 | 49 | \item{transformRef}{ID of reference sample for shape to which color patterns will be transformed 50 | to. Can be 'meanshape' for transforming to mean shape of Procrustes analysis.} 51 | 52 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 53 | (default ='tps').} 54 | 55 | \item{removebg}{Integer or RGB vector indicating the range of RGB threshold to remove from 56 | image (e.g. 100 removes pixels with average RGB > 100; default = NULL).} 57 | 58 | \item{removebgColOffset}{Color offset for color background extraction (default = 0.10).} 59 | 60 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 61 | coordinates (default = FALSE).} 62 | 63 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE).} 64 | 65 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 66 | 67 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 68 | } 69 | \value{ 70 | List of summed raster for each k-means cluster objects. 71 | } 72 | \description{ 73 | Aligns images usings transformations obtained from fixed landmarks and extracts colors using 74 | k-means clustering. 75 | } 76 | \examples{ 77 | \dontrun{ 78 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 79 | prepath <- system.file("extdata", package = 'patternize') 80 | extension <- '_landmarks_LFW.txt' 81 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 82 | 83 | extension <- '.jpg' 84 | imageList <- makeList(IDlist, 'image', prepath, extension) 85 | # Note that this example only aligns two images with the target, 86 | # remove [1:2] to run a full examples. 87 | rasterList_lanK <- patLanK(imageList[1:2], landmarkList[1:2], k = 4, crop = TRUE, 88 | res = 100, removebg = 100, adjustCoords = TRUE, plot = TRUE) 89 | } 90 | 91 | } 92 | -------------------------------------------------------------------------------- /man/patLanK_HSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patLanK_HSV.R 3 | \name{patLanK_HSV} 4 | \alias{patLanK_HSV} 5 | \title{Aligns images usings transformations obtained from fixed landmarks and extracts colors using 6 | k-means clustering.} 7 | \usage{ 8 | patLanK_HSV( 9 | sampleList, 10 | landList, 11 | k = 3, 12 | fixedStartCenter = NULL, 13 | resampleFactor = NULL, 14 | crop = FALSE, 15 | cropOffset = c(0, 0, 0, 0), 16 | res = 300, 17 | transformRef = "meanshape", 18 | transformType = "tps", 19 | removebgK = NULL, 20 | adjustCoords = FALSE, 21 | plot = FALSE, 22 | focal = FALSE, 23 | sigma = 3, 24 | ignoreHSVvalue = FALSE 25 | ) 26 | } 27 | \arguments{ 28 | \item{sampleList}{List of RasterStack objects.} 29 | 30 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 31 | 32 | \item{k}{Integere for defining number of k-means clusters (default = 3).} 33 | 34 | \item{fixedStartCenter}{Specify a dataframe with start centers for k-means clustering.} 35 | 36 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 37 | 38 | \item{crop}{Whether to use the landmarks range to crop the image. This can significantly speed 39 | up the analysis (default = FALSE).} 40 | 41 | \item{cropOffset}{Vector c(xmin, xmax, ymin, ymax) that specifies the number of pixels you 42 | want the cropping to be offset from the landmarks (in case the landmarks do not surround 43 | the entire color pattern). The values specified should present the percentage of the maximum 44 | landmark value along the x and y axis.} 45 | 46 | \item{res}{Resolution for color pattern raster (default = 300). This should be reduced if the 47 | number of pixels in the image is lower than th raster.} 48 | 49 | \item{transformRef}{ID of reference sample for shape to which color patterns will be transformed 50 | to. Can be 'meanshape' for transforming to mean shape of Procrustes analysis.} 51 | 52 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 53 | (default ='tps').} 54 | 55 | \item{removebgK}{Integer indicating the range RGB treshold to remove from image (e.g. 100 56 | removes pixels with average RGB > 100; default = NULL) for k-means analysis. This works only 57 | to remove a white background.} 58 | 59 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 60 | coordinates (default = FALSE).} 61 | 62 | \item{plot}{Whether to plot transformed color patterns while processing (default = FALSE).} 63 | 64 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 65 | 66 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 67 | 68 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 69 | } 70 | \value{ 71 | List of summed raster for each k-means cluster objects. 72 | } 73 | \description{ 74 | Aligns images usings transformations obtained from fixed landmarks and extracts colors using 75 | k-means clustering. 76 | } 77 | \examples{ 78 | \dontrun{ 79 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 80 | prepath <- system.file("extdata", package = 'patternize') 81 | extension <- '_landmarks_LFW.txt' 82 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 83 | 84 | extension <- '.jpg' 85 | imageList <- makeList(IDlist, 'image', prepath, extension) 86 | # Note that this example only aligns two images with the target, 87 | # remove [1:2] to run a full examples. 88 | rasterList_lanK <- patLanK(imageList[1:2], landmarkList[1:2], k = 4, crop = TRUE, 89 | res = 100, removebgK = 100, adjustCoords = TRUE, plot = TRUE) 90 | } 91 | 92 | } 93 | -------------------------------------------------------------------------------- /man/patLanHSV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patLanHSV.R 3 | \name{patLanHSV} 4 | \alias{patLanHSV} 5 | \title{Aligns images usings transformations obtained from fixed landmarks and extracts colors 6 | using a predefined RGB values and cutoff value.} 7 | \usage{ 8 | patLanHSV( 9 | sampleList, 10 | landList, 11 | HSV, 12 | resampleFactor = NULL, 13 | colOffset = 0.1, 14 | crop = FALSE, 15 | cropOffset = c(0, 0, 0, 0), 16 | res = 300, 17 | transformRef = "meanshape", 18 | transformType = "tps", 19 | adjustCoords = FALSE, 20 | plot = NULL, 21 | focal = FALSE, 22 | sigma = 3, 23 | iterations = 0, 24 | ignoreHSVvalue = FALSE, 25 | patternsToFile = NULL 26 | ) 27 | } 28 | \arguments{ 29 | \item{sampleList}{List of RasterStack objects.} 30 | 31 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 32 | 33 | \item{HSV}{HSV values for color pattern extraction specified as vector.} 34 | 35 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 36 | 37 | \item{colOffset}{Color offset for color pattern extraction (default = 0.10).} 38 | 39 | \item{crop}{Whether to use the landmarks range to crop the image. This can speed up the 40 | analysis (default = FALSE).} 41 | 42 | \item{cropOffset}{Vector c(xmin, xmax, ymin, ymax) that specifies the number of pixels you 43 | want the cropping to be offset from the landmarks (in case the landmarks do not surround 44 | the entire color pattern). The values specified should present the percentage of the maximum 45 | landmark value along the x and y axis.} 46 | 47 | \item{res}{Resolution for color pattern raster (default = 300). This should be reduced if 48 | the number of pixels in the image is lower than th raster.} 49 | 50 | \item{transformRef}{ID of reference sample for shape to which color patterns will be transformed 51 | to. Can be 'meanshape' for transforming to mean shape of Procrustes analysis.} 52 | 53 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 54 | (default ='tps').} 55 | 56 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 57 | coordinates (default = FALSE).} 58 | 59 | \item{plot}{Whether to plot transformed color patterns while processing (default = NULL). 60 | Transformed color patterns can be plot on top of each other ('stack') or next to the 61 | original image for each sample ('compare').} 62 | 63 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 64 | 65 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 66 | 67 | \item{iterations}{Number of iterations for recalculating average color.} 68 | 69 | \item{ignoreHSVvalue}{Whether to ignore the HSV value (~darkness).} 70 | 71 | \item{patternsToFile}{Name of directory to which the color pattern of each individual will be 72 | outputted (default = NULL).} 73 | } 74 | \value{ 75 | List of raster objects. 76 | } 77 | \description{ 78 | Aligns images usings transformations obtained from fixed landmarks and extracts colors 79 | using a predefined RGB values and cutoff value. 80 | } 81 | \examples{ 82 | 83 | \dontrun{ 84 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 85 | prepath <- system.file("extdata", package = 'patternize') 86 | extension <- '_landmarks_LFW.txt' 87 | 88 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 89 | 90 | extension <- '.jpg' 91 | imageList <- makeList(IDlist, 'image', prepath, extension) 92 | 93 | HSV <- c(0.025,1,0.45) 94 | rasterList_lanHSV <- patLanRGB(imageList, landmarkList, HSV, 95 | colOffset = 0.15, crop = TRUE, res = 100, adjustCoords = TRUE, plot = 'stack') 96 | } 97 | 98 | } 99 | -------------------------------------------------------------------------------- /man/patArea.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patArea.R 3 | \name{patArea} 4 | \alias{patArea} 5 | \title{This fucntion calculates the area in which the color pattern is expressed in each sample as the 6 | relative proportion using the provided outline of the considered trait or structure.} 7 | \usage{ 8 | patArea( 9 | rList, 10 | IDlist, 11 | refShape, 12 | type, 13 | outline = NULL, 14 | landList = NULL, 15 | adjustCoords = FALSE, 16 | cartoonID = NULL, 17 | crop = c(0, 0, 0, 0), 18 | flipRaster = NULL, 19 | flipOutline = NULL, 20 | imageList = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{rList}{List of RasterLayers as obtained from the main patternize functions.} 25 | 26 | \item{IDlist}{List of sample IDs.} 27 | 28 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 29 | registration analysis) or 'mean' if the images were transformed to a mean shape using landmark 30 | transformation.} 31 | 32 | \item{type}{Type of rasterlist; 'RGB' or 'k' (result from RGB or k-means analysis, respectively).} 33 | 34 | \item{outline}{xy coordinates that define outline.} 35 | 36 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 37 | 38 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 39 | coordinates (default = FALSE).} 40 | 41 | \item{cartoonID}{ID of the sample for which the cartoon was drawn.} 42 | 43 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 44 | original image used in landmark or registration analysis.} 45 | 46 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency between 47 | raster and outline coordinates).} 48 | 49 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 50 | 51 | \item{imageList}{List of images as obtained from \code{\link[patternize]{makeList}} should be given 52 | if one wants to flip the outline or adjust landmark coordinates.} 53 | } 54 | \value{ 55 | Table or list of tables with sample IDs and relative area of color pattern or kmeans cluster. 56 | } 57 | \description{ 58 | This fucntion calculates the area in which the color pattern is expressed in each sample as the 59 | relative proportion using the provided outline of the considered trait or structure. 60 | } 61 | \examples{ 62 | 63 | data(rasterList_lanRGB) 64 | #data(rasterList_regRGB) 65 | #data(rasterList_lanK) 66 | #data(rasterList_regK) 67 | 68 | data(imageList) 69 | 70 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 71 | 72 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 73 | '/BC0077_outline.txt', sep=''), header = FALSE) 74 | 75 | prepath <- system.file("extdata", package = 'patternize') 76 | extension <- '_landmarks_LFW.txt' 77 | 78 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 79 | 80 | \dontrun{ 81 | area_lanRGB <- patArea(rasterList_lanRGB, IDlist, refShape = 'mean', type = 'RGB', 82 | outline = outline_BC0077, landList = landmarkList, adjustCoords = TRUE, 83 | imageList = imageList, cartoonID = 'BC0077') 84 | 85 | area_regRGB <- patArea(rasterList_regRGB, IDlist, refShape = 'target', type = 'RGB', 86 | outline = outline_BC0077, crop = c(100,400,40,250), adjustCoords = TRUE, 87 | imageList = imageList, cartoonID = 'BC0077', flipRaster = 'xy') 88 | 89 | areaList_lanK <- patArea(rasterList_lanK, IDlist, refShape = 'mean', type = 'k', 90 | outline = outline_BC0077, landList = landmarkList, adjustCoords = TRUE, 91 | imageList = imageList, cartoonID = 'BC0077') 92 | 93 | areaList_regK <- patArea(rasterList_regK, IDlist, refShape = 'target', type = 'k', 94 | outline = outline_BC0077, crop = c(100,400,40,250), adjustCoords = TRUE, 95 | imageList = imageList, cartoonID = 'BC0077', flipRaster = 'xy') 96 | } 97 | 98 | } 99 | -------------------------------------------------------------------------------- /man/patLanRGB.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patLanRGB.R 3 | \name{patLanRGB} 4 | \alias{patLanRGB} 5 | \title{Aligns images usings transformations obtained from fixed landmarks and extracts colors 6 | using a predefined RGB values and cutoff value.} 7 | \usage{ 8 | patLanRGB( 9 | sampleList, 10 | landList, 11 | RGB = NULL, 12 | sampleRGB = FALSE, 13 | sampleRGBtype = "point", 14 | resampleFactor = NULL, 15 | colOffset = 0.1, 16 | crop = FALSE, 17 | cropOffset = c(0, 0, 0, 0), 18 | res = 300, 19 | transformRef = "meanshape", 20 | transformType = "tps", 21 | adjustCoords = FALSE, 22 | plot = NULL, 23 | focal = FALSE, 24 | sigma = 3, 25 | iterations = 0, 26 | imageIDs = NULL, 27 | patternsToFile = NULL 28 | ) 29 | } 30 | \arguments{ 31 | \item{sampleList}{List of RasterStack objects.} 32 | 33 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 34 | 35 | \item{RGB}{RGB values for color pattern extraction specified as vector.} 36 | 37 | \item{sampleRGB}{Whether to set RGB for each image manually.} 38 | 39 | \item{sampleRGBtype}{Whether to pick a point or area (defined by left bottom and top right) 40 | for sampleRGB.} 41 | 42 | \item{resampleFactor}{Integer for downsampling used by \code{\link{redRes}}.} 43 | 44 | \item{colOffset}{Color offset for color pattern extraction (default = 0.10).} 45 | 46 | \item{crop}{Whether to use the landmarks range to crop the image. This can speed up the 47 | analysis (default = FALSE).} 48 | 49 | \item{cropOffset}{Vector c(xmin, xmax, ymin, ymax) that specifies the number of pixels you 50 | want the cropping to be offset from the landmarks (in case the landmarks do not surround 51 | the entire color pattern). The values specified should present the percentage of the maximum 52 | landmark value along the x and y axis.} 53 | 54 | \item{res}{Resolution for color pattern raster (default = 300). This should be reduced if 55 | the number of pixels in the image is lower than th raster.} 56 | 57 | \item{transformRef}{ID of reference sample for shape to which color patterns will be transformed 58 | to. Can be 'meanshape' for transforming to mean shape of Procrustes analysis.} 59 | 60 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 61 | (default ='tps').} 62 | 63 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 64 | coordinates (default = FALSE).} 65 | 66 | \item{plot}{Whether to plot transformed color patterns while processing (default = NULL). 67 | Transformed color patterns can be plot on top of each other ('stack') or next to the 68 | original image for each sample ('compare').} 69 | 70 | \item{focal}{Whether to perform Gaussian blurring (default = FALSE).} 71 | 72 | \item{sigma}{Size of sigma for Gaussian blurring (default = 3).} 73 | 74 | \item{iterations}{Number of iterations for recalculating average color.} 75 | 76 | \item{imageIDs}{A list of IDs to match landmarks to images if landmarkList and imageList don't 77 | have the same length.} 78 | 79 | \item{patternsToFile}{Name of directory to which the color pattern of each individual will be 80 | outputted (default = NULL).} 81 | } 82 | \value{ 83 | List of raster objects. 84 | } 85 | \description{ 86 | Aligns images usings transformations obtained from fixed landmarks and extracts colors 87 | using a predefined RGB values and cutoff value. 88 | } 89 | \examples{ 90 | 91 | \dontrun{ 92 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 93 | prepath <- system.file("extdata", package = 'patternize') 94 | extension <- '_landmarks_LFW.txt' 95 | 96 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 97 | 98 | extension <- '.jpg' 99 | imageList <- makeList(IDlist, 'image', prepath, extension) 100 | 101 | RGB <- c(114,17,0) 102 | rasterList_lanRGB <- patLanRGB(imageList, landmarkList, RGB, 103 | colOffset = 0.15, crop = TRUE, res = 100, adjustCoords = TRUE, plot = 'stack') 104 | } 105 | 106 | } 107 | -------------------------------------------------------------------------------- /R/alignReg.R: -------------------------------------------------------------------------------- 1 | #' Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration.. 2 | #' 3 | #' @param sampleList List of RasterStack objects. 4 | #' @param target Image imported as RasterStack used as target for registration. 5 | #' @param resampleFactor Integer for downsampling used by \code{\link{redRes}} (default = NULL). 6 | #' @param useBlockPercentage Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 7 | #' (default = 75). 8 | #' @param crop Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 9 | #' original image. 10 | #' @param removebgR Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 11 | #' pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 12 | #' remove a white background. 13 | #' @param maskOutline When outline is specified, everything outside of the outline will be masked for 14 | #' the color extraction (default = NULL). 15 | #' @param plotTransformed Whether to plot transformed images while processing (default = FALSE). 16 | #' 17 | #' @return List of raster objects. 18 | #' 19 | #' 20 | #' @export 21 | #' @import raster 22 | 23 | alignReg <- function(sampleList, 24 | target, 25 | resampleFactor = NULL, 26 | useBlockPercentage = 75, 27 | crop = c(0,0,0,0), 28 | removebgR = NULL, 29 | maskOutline = NULL, 30 | plotTransformed = FALSE){ 31 | 32 | rasterList <- list() 33 | 34 | if(!identical(crop, c(0,0,0,0))){ 35 | 36 | targetExtRaster <- crop 37 | target <- raster::crop(target, targetExtRaster) 38 | } 39 | 40 | if(!is.null(resampleFactor)){ 41 | target <- redRes(target, resampleFactor) 42 | } 43 | 44 | targetA <- apply(raster::as.array(target), 1:2, mean) 45 | 46 | if(is.numeric(removebgR)){ 47 | 48 | targetA <- apply(targetA, 1:2, function(x) ifelse(x > removebgR, 0, x)) 49 | } 50 | 51 | for(n in 1:length(sampleList)){ 52 | 53 | sStack <- sampleList[[n]] 54 | extRaster <- raster::extent(sStack) 55 | 56 | if(!identical(crop, c(0,0,0,0))){ 57 | 58 | extRaster <- crop 59 | sStack <- crop(sStack, extRaster) 60 | } 61 | 62 | sourceRaster <- redRes(sStack, 1) 63 | 64 | if(!is.null(resampleFactor)){ 65 | sourceRaster <- redRes(sStack, resampleFactor) 66 | } 67 | 68 | 69 | sourceRasterK <- sourceRaster 70 | 71 | sourceRaster <- apply(raster::as.array(sourceRaster), 1:2, mean) 72 | 73 | if(is.numeric(removebgR)){ 74 | 75 | sourceRaster <- apply(sourceRaster, 1:2, function(x) ifelse(x > removebgR, 0, x)) 76 | } 77 | 78 | result <- RNiftyReg::niftyreg(sourceRaster, targetA, useBlockPercentage=useBlockPercentage) 79 | 80 | transformedMap <- RNiftyReg::applyTransform(RNiftyReg::forward(result), raster::as.array(sourceRasterK), interpolation=0) 81 | r1 <- raster::raster(transformedMap[1:nrow(transformedMap),ncol(transformedMap):1,1]) 82 | r2 <- raster::raster(transformedMap[1:nrow(transformedMap),ncol(transformedMap):1,2]) 83 | r3 <- raster::raster(transformedMap[1:nrow(transformedMap),ncol(transformedMap):1,3]) 84 | 85 | 86 | transRaster <-raster::stack(r1,r2,r3) 87 | transRaster <- raster::flip(transRaster,'x') 88 | 89 | raster::extent(transRaster) <- raster::extent(sourceRasterK) 90 | 91 | 92 | if(!is.null(maskOutline)){ 93 | 94 | transRaster <- maskOutline(transRaster, maskOutline, refShape = 'target', flipOutline = 'y', crop = crop, 95 | imageList = sampleList) 96 | } 97 | # transRaster[transRaster == 0] <- NA 98 | 99 | 100 | 101 | 102 | if(!identical(raster::extent(transRaster), raster::extent(target))){ 103 | raster::extent(transRaster) <- raster::extent(target) 104 | } 105 | 106 | # transRaster <- raster::flip(transRaster,'y') 107 | 108 | if(plotTransformed){ 109 | 110 | x <- as.array(transRaster)/255 111 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 112 | uniqueCols <- unique(cols) 113 | x2 <- match(cols, uniqueCols) 114 | dim(x2) <- dim(x)[1:2] 115 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 116 | 117 | } 118 | 119 | rasterList[[names(sampleList)[n]]] <- transRaster 120 | 121 | print(paste('sample', names(sampleList)[n], 'done and added to imageList', sep=' ')) 122 | } 123 | 124 | return(rasterList) 125 | } 126 | -------------------------------------------------------------------------------- /man/patRegW.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRegW.R 3 | \name{patRegW} 4 | \alias{patRegW} 5 | \title{Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 6 | and extracts color pattern using watershed segmentation. This function works interactively by 7 | allowing to pick a starting pixel within each pattern element from which the watershed will 8 | extract the pattern. This function works best for patterns with sharp boundaries.} 9 | \usage{ 10 | patRegW( 11 | sampleList, 12 | target, 13 | resampleFactor = NULL, 14 | useBlockPercentage = 75, 15 | crop = c(0, 0, 0, 0), 16 | removebgR = NULL, 17 | maskOutline = NULL, 18 | cartoonID = NULL, 19 | correct = FALSE, 20 | blur = TRUE, 21 | sigma = 3, 22 | bucketfill = TRUE, 23 | cleanP = NULL, 24 | splitC = NULL, 25 | plotTransformed = FALSE, 26 | plotCorrect = FALSE, 27 | plotEdges = FALSE, 28 | plotPriority = FALSE, 29 | plotWS = FALSE, 30 | plotBF = FALSE, 31 | plotFinal = FALSE 32 | ) 33 | } 34 | \arguments{ 35 | \item{sampleList}{List of RasterStack objects.} 36 | 37 | \item{target}{Image imported as RasterStack used as target for registration.} 38 | 39 | \item{resampleFactor}{Integer for downsampling image used by \code{\link{redRes}}.} 40 | 41 | \item{useBlockPercentage}{Block percentage as used in \code{\link[RNiftyReg]{niftyreg}} 42 | (default = 75).} 43 | 44 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 45 | original image.} 46 | 47 | \item{removebgR}{Integer indicating the range RGB treshold to remove from image (e.g. 100 removes 48 | pixels with average RGB > 100; default = NULL) for registration analysis. This works only to 49 | remove a white background.} 50 | 51 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 52 | the color extraction (default = NULL).} 53 | 54 | \item{cartoonID}{ID of the sample for which the cartoon was drawn and will be used for masking.} 55 | 56 | \item{correct}{Correct image illumination using a linear model (default = FALSE).} 57 | 58 | \item{blur}{Blur image for priority map extraction (default = TRUE).} 59 | 60 | \item{sigma}{Size of sigma for Gaussian blurring (default = 5).} 61 | 62 | \item{bucketfill}{Use a bucket fill on the background to fill holes (default = TRUE).} 63 | 64 | \item{cleanP}{Integer to remove spurious areas with width smaller than cleanP (default = NULL).} 65 | 66 | \item{splitC}{Integer to split selected patterns into connected components and remove ones with 67 | areas smaller than splitC (default = NULL).} 68 | 69 | \item{plotTransformed}{Plot transformed image (default = FALSE).} 70 | 71 | \item{plotCorrect}{Plot corrected image, corrected for illumination using a linear model 72 | (default = FALSE).} 73 | 74 | \item{plotEdges}{Plot image gradient (default = FALSE).} 75 | 76 | \item{plotPriority}{Plot priority map (default = FALSE).} 77 | 78 | \item{plotWS}{Plot watershed result (default = FALSE).} 79 | 80 | \item{plotBF}{Plot bucketfill (default = FALSE).} 81 | 82 | \item{plotFinal}{Plot extracted patterns (default = FALSE).} 83 | } 84 | \value{ 85 | List of raster objects. 86 | } 87 | \description{ 88 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image registration 89 | and extracts color pattern using watershed segmentation. This function works interactively by 90 | allowing to pick a starting pixel within each pattern element from which the watershed will 91 | extract the pattern. This function works best for patterns with sharp boundaries. 92 | } 93 | \examples{ 94 | \dontrun{ 95 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 96 | prepath <- system.file("extdata", package = 'patternize') 97 | extension <- '.jpg' 98 | 99 | imageList <- makeList(IDlist, 'image', prepath, extension) 100 | 101 | target <- imageList[[1]] 102 | 103 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 104 | '/BC0077_outline.txt', sep=''), header = FALSE) 105 | 106 | rasterList_regW <- patRegW(imageList, target, plotTransformed = FALSE, cartoonID = 'BC0077', 107 | correct = TRUE, plotCorrect = FALSE, blur = FALSE, sigma = 2, 108 | bucketfill = FALSE, cleanP = 0, splitC = 10, plotPriority = TRUE, 109 | plotWS = FALSE, plotBF = FALSE, plotFinal = TRUE, removebgR = 100, 110 | maskOutline = outline_BC0077) 111 | } 112 | 113 | } 114 | -------------------------------------------------------------------------------- /man/patLanW.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patLanW.R 3 | \name{patLanW} 4 | \alias{patLanW} 5 | \title{Extracts color pattern from landmark transformed image using watershed segmentation. This function 6 | works interactively by allowing to pick a starting pixel within each pattern element from which the 7 | watershed will extract the pattern. This function works best for patterns with sharp boundaries.} 8 | \usage{ 9 | patLanW( 10 | sampleList, 11 | landList, 12 | IDlist = NULL, 13 | adjustCoords = FALSE, 14 | transformRef = "meanshape", 15 | resampleFactor = NULL, 16 | transformType = "tps", 17 | maskOutline = NULL, 18 | cartoonID = NULL, 19 | correct = FALSE, 20 | blur = TRUE, 21 | sigma = 3, 22 | bucketfill = TRUE, 23 | cleanP = NULL, 24 | splitC = NULL, 25 | plotTransformed = FALSE, 26 | plotCorrect = FALSE, 27 | plotEdges = FALSE, 28 | plotPriority = FALSE, 29 | plotWS = FALSE, 30 | plotBF = FALSE, 31 | plotFinal = FALSE 32 | ) 33 | } 34 | \arguments{ 35 | \item{sampleList}{List of RasterStack objects.} 36 | 37 | \item{landList}{Landmark list as returned by \code{\link[patternize]{makeList}}.} 38 | 39 | \item{IDlist}{List of sample IDs should be specified when masking outline and transformRef 40 | is 'meanshape'.} 41 | 42 | \item{adjustCoords}{Adjust landmark coordinates in case they are reversed compared to pixel 43 | coordinates (default = FALSE).} 44 | 45 | \item{transformRef}{ID or landmark matrix of reference sample for shape to which color patterns 46 | will be transformed to. Can be 'meanshape' for transforming to mean shape of Procrustes 47 | analysis.} 48 | 49 | \item{resampleFactor}{Integer for downsampling image used by \code{\link{redRes}}.} 50 | 51 | \item{transformType}{Transformation type as used by \code{\link[Morpho]{computeTransform}} 52 | (default ='tps').} 53 | 54 | \item{maskOutline}{When outline is specified, everything outside of the outline will be masked for 55 | the color extraction (default = NULL).} 56 | 57 | \item{cartoonID}{ID of the sample for which the cartoon was drawn and will be used for masking 58 | (should be set when transformRef = 'meanShape').} 59 | 60 | \item{correct}{Correct image illumination using a linear model (default = FALSE).} 61 | 62 | \item{blur}{Blur image for priority map extraction (default = TRUE).} 63 | 64 | \item{sigma}{Size of sigma for Gaussian blurring (default = 5).} 65 | 66 | \item{bucketfill}{Use a bucket fill on the background to fill holes (default = TRUE).} 67 | 68 | \item{cleanP}{Integer to remove spurious areas with width smaller than cleanP (default = NULL).} 69 | 70 | \item{splitC}{Integer to split selected patterns into connected components and remove ones with 71 | areas smaller than splitC (default = NULL).} 72 | 73 | \item{plotTransformed}{Plot transformed image (default = FALSE).} 74 | 75 | \item{plotCorrect}{Plot corrected image, corrected for illumination using a linear model 76 | (default = FALSE).} 77 | 78 | \item{plotEdges}{Plot image gradient (default = FALSE).} 79 | 80 | \item{plotPriority}{Plot priority map (default = FALSE).} 81 | 82 | \item{plotWS}{Plot watershed result (default = FALSE).} 83 | 84 | \item{plotBF}{Plot bucketfill (default = FALSE).} 85 | 86 | \item{plotFinal}{Plot extracted patterns (default = FALSE).} 87 | } 88 | \value{ 89 | List of raster objects. 90 | } 91 | \description{ 92 | Extracts color pattern from landmark transformed image using watershed segmentation. This function 93 | works interactively by allowing to pick a starting pixel within each pattern element from which the 94 | watershed will extract the pattern. This function works best for patterns with sharp boundaries. 95 | } 96 | \examples{ 97 | 98 | \dontrun{ 99 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 100 | prepath <- system.file("extdata", package = 'patternize') 101 | extension <- '_landmarks_LFW.txt' 102 | 103 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 104 | 105 | extension <- '.jpg' 106 | imageList <- makeList(IDlist, 'image', prepath, extension) 107 | 108 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 109 | '/BC0077_outline.txt', sep=''), header = FALSE) 110 | 111 | rasterList_W <- patLanW(imageList, landmarkList, IDlist, transformRef = 'meanshape', 112 | adjustCoords = TRUE, plotTransformed = FALSE, correct = TRUE, plotCorrect = FALSE, blur = FALSE, 113 | sigma = 2, bucketfill = FALSE, cleanP = 0, splitC = 10, plotPriority = TRUE, plotWS = TRUE, 114 | plotBF = TRUE, plotFinal = TRUE, maskOutline = outline_BC0077, cartoonID = 'BC0077') 115 | } 116 | 117 | } 118 | -------------------------------------------------------------------------------- /R/createPhenotype.R: -------------------------------------------------------------------------------- 1 | #' Plot color pattern prediction for specified PCA values 2 | #' 3 | #' @param PCAdata Output of PCA analysis. List item 3 of patPCA. 4 | #' @param PCApredict A vector with the PCA values for which to predict the phenotype. This vector 5 | #' only needs to include the values upto the last PCA axis to predict along, other values are 6 | #' set to zero. 7 | #' @param IDlist List of sample IDs. 8 | #' @param rasterList rasterList used for PCA. 9 | #' @param colpalette Vector of colors for color palette 10 | #' (default = c("white","lightblue","blue","green", "yellow","red")) 11 | #' @param plotCartoon Whether to plot a cartoon. This cartoon should be drawn on one of the samples 12 | #' used in the analysis. 13 | #' @param refShape This can be 'target' in case the reference shape is a single sample (for 14 | #' registration analysis) or 'mean' if the images were transformed to a mean shape (only for 15 | #' meanshape when using landmark transformation) 16 | #' @param outline xy coordinates that define outline. 17 | #' @param lines list of files with xy coordinates of line objects to be added to cartoon. 18 | #' @param landList Landmark landmarkList. 19 | #' @param adjustCoords Adjust landmark coordinates. 20 | #' @param cartoonID ID of the sample for which the cartoon was drawn. 21 | #' @param normalized Set this to true in case the summed rasters are already devided by the 22 | #' sample number. 23 | #' @param crop Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop 24 | #' the original image used in landmark or registration analysis. 25 | #' @param flipRaster Whether to flip raster along xy axis (in case there is an inconsistency 26 | #' between raster and outline coordinates). 27 | #' @param flipOutline Whether to flip plot along x, y or xy axis. 28 | #' @param imageList List of images should be given if one wants to flip the outline or adjust 29 | #' landmark coordinates. 30 | #' @param cartoonOrder Whether to plot the cartoon outline 'above' or 'under' the pattern raster 31 | #' (default = 'above'). Set to 'under' for filled outlines. 32 | #' @param lineOrder Whether to plot the cartoon lines 'above' or 'under' the pattern raster 33 | #' (default = 'above'). 34 | #' @param cartoonCol Outline and line color for cartoon (deafault = 'gray'). 35 | #' @param cartoonFill Fill color for outline of cartoon (default = NULL). 36 | #' @param legendTitle Title of the raster legend (default = 'Proportion'). 37 | #' @param zlim zlim values for predicted pattern. 38 | #' 39 | #' @export 40 | #' @import raster 41 | 42 | createPhenotype <- function(PCAdata, 43 | PCApredict, 44 | IDlist, 45 | rasterList, 46 | colpalette = NULL, 47 | plotCartoon = FALSE, 48 | refShape = NULL, 49 | outline = NULL, 50 | lines = NULL, 51 | landList = NULL, 52 | adjustCoords = FALSE, 53 | cartoonID = NULL, 54 | normalized = TRUE, 55 | crop = c(0,0,0,0), 56 | flipRaster = NULL, 57 | flipOutline = NULL, 58 | imageList = NULL, 59 | cartoonOrder = 'above', 60 | lineOrder = 'above', 61 | cartoonCol = 'gray', 62 | cartoonFill = NULL, 63 | legendTitle = 'Proportion', 64 | zlim = NULL){ 65 | 66 | pc <- PCAdata$x 67 | rotation <- PCAdata$rotation 68 | 69 | pc.vec <- rep(0, dim(pc)[1]) 70 | pc.vec[1:length(PCApredict)] <- PCApredict 71 | 72 | pc.pred <- pc.vec %*% t(rotation) 73 | 74 | pc.pred.image <- t(matrix(pc.pred, ncol = dim(rasterList[[1]])[1], nrow = dim(rasterList[[1]])[2])) 75 | 76 | pc.pred.image.raster <-raster::raster(pc.pred.image) 77 | 78 | raster::extent(pc.pred.image.raster) <- raster::extent(rasterList[[1]]) 79 | 80 | if(is.null(zlim)){ 81 | plotHeat(pc.pred.image.raster, IDlist, plotCartoon = TRUE, refShape = refShape, outline = outline, lines = lines, 82 | adjustCoords = TRUE, landList = landList, imageList = imageList, cartoonID = cartoonID, colpalette = colpalette, 83 | cartoonFill = 'black', cartoonOrder = 'under', 84 | zlim = c(min(raster::values(pc.pred.image.raster)),max(raster::values(pc.pred.image.raster))), 85 | normalized = normalized) 86 | } 87 | else{ 88 | plotHeat(pc.pred.image.raster, IDlist, plotCartoon = TRUE, refShape = refShape, outline = outline, lines = lines, 89 | adjustCoords = TRUE, landList = landList, imageList = imageList, cartoonID = cartoonID, colpalette = colpalette, 90 | cartoonFill = 'black', cartoonOrder = 'under', zlim = zlim, normalized = normalized) 91 | } 92 | } 93 | 94 | 95 | 96 | 97 | 98 | -------------------------------------------------------------------------------- /R/sampleLandmarks.R: -------------------------------------------------------------------------------- 1 | #' Sample landmarks in an image. 2 | #' 3 | #' @param sampleList RasterStack or list of RasterStack objects as obtained 4 | #' by \code{\link{makeList}}. 5 | #' @param resampleFactor Integer for downsampling the image(s) used by \code{\link{redRes}}. 6 | #' @param crop Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop the 7 | #' original image. 8 | #' 9 | #' @return landmark matrix or landmark list 10 | #' 11 | #' @examples 12 | #' 13 | #' \dontrun{ 14 | #' IDlist <- c('BC0077','BC0071') 15 | #' prepath <- system.file("extdata", package = 'patternize') 16 | #' extension <- '.jpg' 17 | #' imageList <- makeList(IDlist, 'image', prepath, extension) 18 | #' 19 | #' landmarkList <- sampleLandmarks(imageList) 20 | #' } 21 | #' 22 | #' @export 23 | #' @import raster 24 | #' @importFrom imager as.cimg imsub 25 | #' @importFrom graphics locator 26 | 27 | sampleLandmarks <- function(sampleList, 28 | resampleFactor = NULL, 29 | crop = c(0,0,0,0)){ 30 | 31 | objectList <- list() 32 | 33 | if(length(sampleList) > 1){ 34 | 35 | for(n in 1:length(sampleList)){ 36 | 37 | image <- sampleList[[n]] 38 | 39 | rasterExt <- raster::extent(image) 40 | 41 | # Reduce resolution 42 | if(!is.null(resampleFactor)){ 43 | 44 | image <- redRes(image, resampleFactor) 45 | raster::extent(image) <- c(rasterExt[1]/resampleFactor, 46 | rasterExt[2]/resampleFactor, 47 | rasterExt[3]/resampleFactor, 48 | rasterExt[4]/resampleFactor) 49 | } 50 | 51 | if(is.null(resampleFactor)){ 52 | resampleFactor <- 1 53 | } 54 | 55 | # Crop image 56 | if(!identical(crop, c(0,0,0,0))){ 57 | 58 | rasterExt <- crop 59 | image <- raster::crop(image, rasterExt) 60 | } 61 | 62 | # Transform to imager format 63 | imA <- raster::as.array(image) 64 | imR <- as.raster(imA, nrow = dim(image)[1], ncol = dim(image)[2], max = 255) 65 | im <- imager::as.cimg(imR) 66 | 67 | plot(im) 68 | 69 | print(paste('Choose landmarks for image', names(sampleList)[n], sep=' ')) 70 | print('Click outside image area to continue.') 71 | 72 | xyCoords <- c() 73 | 74 | lN <- 0 75 | 76 | while(1){ 77 | 78 | xy <- locator(n=1) 79 | 80 | if(any(c(as.numeric(xy)[1] > dim(im)[1], as.numeric(xy)[1] < 0, as.numeric(xy)[2] > dim(im)[1], as.numeric(xy)[2] < 0))){ 81 | 82 | if(n != length(sampleList)){ 83 | print('Loading next image...') 84 | } 85 | 86 | break 87 | } 88 | 89 | lN <- lN + 1 90 | 91 | xy$x <- xy$x * resampleFactor + crop[1]*resampleFactor 92 | xy$y <- xy$y * resampleFactor + crop[3]*resampleFactor 93 | 94 | print(paste('x', lN, ': ', as.character(xy)[1], ' y', lN, ': ', as.character(xy)[2], sep='')) 95 | 96 | xyCoords <- c(xyCoords, c(xy$x, xy$y)) 97 | } 98 | 99 | landmarks <- matrix(xyCoords, ncol=2, byrow=T) 100 | 101 | objectList[[names(sampleList)[n]]] <- landmarks 102 | 103 | } 104 | } 105 | 106 | if(length(sampleList) == 1){ 107 | 108 | image <- sampleList[[1]] 109 | 110 | rasterExt <- raster::extent(image) 111 | 112 | if(!is.null(resampleFactor)){ 113 | 114 | image <- redRes(image, resampleFactor) 115 | raster::extent(image) <- c(rasterExt[1]/resampleFactor, 116 | rasterExt[2]/resampleFactor, 117 | rasterExt[3]/resampleFactor, 118 | rasterExt[4]/resampleFactor) 119 | } 120 | 121 | if(is.null(resampleFactor)){ 122 | resampleFactor <- 1 123 | } 124 | 125 | # Crop image 126 | if(!identical(crop, c(0,0,0,0))){ 127 | 128 | rasterExt <- crop 129 | image <- raster::crop(image, rasterExt) 130 | } 131 | 132 | # Transform to imager format 133 | imA <- raster::as.array(image) 134 | imR <- as.raster(imA, nrow = dim(image)[1], ncol = dim(image)[2], max = 255) 135 | im <- imager::as.cimg(imR) 136 | 137 | plot(im) 138 | 139 | print(paste('Choose landmarks for image', names(sampleList)[1], sep=' ')) 140 | print('Click outside image area to continue.') 141 | 142 | xyCoords <- c() 143 | 144 | lN <- 0 145 | 146 | while(1){ 147 | 148 | xy <- locator(n=1) 149 | 150 | if(any(c(as.numeric(xy)[1] > dim(im)[1], as.numeric(xy)[1] < 0, as.numeric(xy)[2] > dim(im)[1], as.numeric(xy)[2] < 0))){ 151 | break 152 | } 153 | 154 | lN <- lN + 1 155 | xy$x <- xy$x * resampleFactor + crop[1]*resampleFactor 156 | xy$y <- xy$y * resampleFactor + crop[3]*resampleFactor 157 | 158 | print(paste('x', lN, ': ', as.character(xy)[1], ' y', lN, ': ', as.character(xy)[2], sep='')) 159 | 160 | xyCoords <- c(xyCoords, c(xy$x, xy$y)) 161 | } 162 | 163 | objectList <- matrix(xyCoords, ncol=2, byrow=T) 164 | } 165 | 166 | return(objectList) 167 | } 168 | -------------------------------------------------------------------------------- /R/patGMM.R: -------------------------------------------------------------------------------- 1 | #' Extract colors using GMM clustering (for pre-aligned images). 2 | #' 3 | #' @param sampleList List of RasterStack objects. 4 | #' @param k Integere for defining number of clusters (default = 3). 5 | #' @param resampleFactor Integer for downsampling used by \code{\link{redRes}}. 6 | #' @param maskOutline When outline is specified, everything outside of the outline will be masked for 7 | #' the color extraction (default = NULL). 8 | #' @param plot Whether to plot transformed color patterns while processing (default = FALSE). 9 | #' @param focal Whether to perform Gaussian blurring (default = FALSE). 10 | #' @param sigma Size of sigma for Gaussian blurring (default = 3). 11 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 12 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 13 | #' first (default = FALSE). 14 | #' 15 | #' @return List of summed raster for each k-means cluster objects. 16 | #' 17 | #' 18 | #' @export 19 | #' @import raster 20 | #' @importFrom utils capture.output 21 | 22 | patGMM <- function(sampleList, 23 | k = 3, 24 | resampleFactor = NULL, 25 | maskOutline = NULL, 26 | plot = FALSE, 27 | focal = FALSE, 28 | sigma = 3, 29 | maskToNA = NULL, 30 | kmeansOnAll = FALSE){ 31 | 32 | rasterList <- list() 33 | 34 | 35 | for(n in 1:length(sampleList)){ 36 | 37 | image <- sampleList[[n]] 38 | extRasterOr <- raster::extent(image) 39 | 40 | if(!is.null(resampleFactor)){ 41 | image <- redRes(image, resampleFactor) 42 | } 43 | 44 | if(focal){ 45 | gf <- focalWeight(image, sigma, "Gauss") 46 | 47 | rrr1 <- raster::focal(image[[1]], gf) 48 | rrr2 <- raster::focal(image[[2]], gf) 49 | rrr3 <- raster::focal(image[[3]], gf) 50 | 51 | image <- raster::stack(rrr1, rrr2, rrr3) 52 | } 53 | 54 | if(!is.null(maskOutline))( 55 | image <- maskOutline(image, maskOutline, refShape = 'target', flipOutline = 'y', imageList = sampleList) 56 | ) 57 | 58 | if(!is.null(maskToNA)){ 59 | image[image == maskToNA] <- NA 60 | 61 | } 62 | 63 | # k-means clustering of image 64 | 65 | if(kmeansOnAll == FALSE){ 66 | 67 | # imageKmeans <- tryCatch(GMMImage(raster::as.array(image), k), 68 | # error = function(err) { 69 | # print(paste('sample', names(sampleList)[n], 'k-clustering failed and skipped', sep = ' ')) 70 | # return(NULL) 71 | # }) 72 | imageKmeans <- GMMImage(raster::as.array(image), k) 73 | if(is.null(imageKmeans)){next} 74 | 75 | image.segmented <- imageKmeans[[1]] 76 | gmm <- imageKmeans[[2]] 77 | 78 | 79 | 80 | if(plot){ 81 | image.segmented[is.na(image.segmented)] <- 0 82 | x <- image.segmented/255 83 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 84 | uniqueCols <- unique(cols) 85 | x2 <- match(cols, uniqueCols) 86 | dim(x2) <- dim(x)[1:2] 87 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 88 | } 89 | 90 | 91 | e=0 92 | 93 | rasterListInd <- list() 94 | 95 | for(i in 1:nrow(gmm$centroids)){ 96 | 97 | e=e+1 98 | 99 | rgb <- gmm$centroids[i,] 100 | 101 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 102 | mapR <- raster::raster(map) 103 | raster::extent(mapR) <- extRasterOr 104 | 105 | rasterListInd[[e]] <- mapR 106 | 107 | 108 | rasterList[[names(sampleList)[n]]] <- rasterListInd 109 | } 110 | 111 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 112 | } 113 | } 114 | 115 | if(kmeansOnAll == TRUE){ 116 | 117 | imageKmeans <- GMMImage(sampleList, k, maskToNA, kmeansOnAll) 118 | 119 | images.segmented <- imageKmeans[[1]] 120 | gmm <- imageKmeans[[2]] 121 | 122 | 123 | 124 | for(n in 1:length(images.segmented)){ 125 | 126 | image.segmented <- images.segmented[[n]] 127 | 128 | if(plot){ 129 | image.segmented[is.na(image.segmented)] <- 0 130 | x <- image.segmented/255 131 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 132 | uniqueCols <- unique(cols) 133 | x2 <- match(cols, uniqueCols) 134 | dim(x2) <- dim(x)[1:2] 135 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 136 | } 137 | 138 | e=0 139 | 140 | rasterListInd <- list() 141 | 142 | for(i in 1:nrow(gmm$centroids)){ 143 | 144 | e=e+1 145 | 146 | rgb <- gmm$centroids[i,] 147 | 148 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 149 | mapR <- raster::raster(map) 150 | raster::extent(mapR) <- extRasterOr 151 | 152 | rasterListInd[[e]] <- mapR 153 | 154 | 155 | rasterList[[names(sampleList)[n]]] <- rasterListInd 156 | } 157 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 158 | } 159 | 160 | } 161 | return(rasterList) 162 | 163 | } 164 | 165 | -------------------------------------------------------------------------------- /R/kImage.R: -------------------------------------------------------------------------------- 1 | #' \code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 2 | #' used by \code{patLanK} and \code{patRegK}. 3 | #' 4 | #' @param image Image imported as a RasterStack for k-means clustering. 5 | #' @param k Integer for number of k-means clusters (default = 3). 6 | #' @param startCenter A matrix of cluster centres to start k-means clustering from (default = NULL). 7 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 8 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 9 | #' first (default = FALSE). 10 | #' 11 | #' @return List including the k-means clustered \code{RasterSatck} returned as an array and object 12 | #' of class "\code{kmeans}". 13 | #' 14 | #' @examples 15 | #' image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 16 | #' out <- kImage(image, 6) 17 | #' 18 | #' @export 19 | #' @import sf 20 | #' @importFrom stats kmeans 21 | #' @importFrom methods is 22 | 23 | kImage <- function(image, 24 | k = 5, 25 | startCenter = NULL, 26 | maskToNA = NULL, 27 | kmeansOnAll = FALSE){ 28 | 29 | if(kmeansOnAll == FALSE){ 30 | 31 | if(is(image)[1] == "RasterStack"){ 32 | image <- raster::as.array(image) 33 | } 34 | 35 | df = data.frame( 36 | red = matrix(image[,,1], ncol=1), 37 | green = matrix(image[,,2], ncol=1), 38 | blue = matrix(image[,,3], ncol=1) 39 | ) 40 | 41 | if(is.null(startCenter)){ 42 | K = kmeans(na.omit(df),k, nstart = 3) 43 | } 44 | else{ 45 | K = kmeans(na.omit(df),startCenter) 46 | } 47 | df$label <- NA 48 | suppressWarnings(df$label[which(!is.na(df$red))] <- K$cluster) 49 | 50 | # df[is.na(df)] <- 0 51 | # df$label = K$cluster 52 | 53 | # Replace color of each pixel with mean RGB value of cluster 54 | 55 | # get the coloring 56 | 57 | colors = data.frame(label = 1:nrow(K$centers), 58 | R = K$centers[,"red"], 59 | G = K$centers[,"green"], 60 | B = K$centers[,"blue"]) 61 | 62 | # merge color codes on df 63 | 64 | df$order = 1:nrow(df) 65 | df = merge(df, colors, all = TRUE) 66 | df = df[order(df$order),] 67 | df$order = NULL 68 | 69 | # Reshape data frame back into an image 70 | 71 | R = matrix(df$R, nrow=dim(image)[1]) 72 | G = matrix(df$G, nrow=dim(image)[1]) 73 | B = matrix(df$B, nrow=dim(image)[1]) 74 | 75 | image.segmented = array(dim=dim(image)) 76 | image.segmented[,,1] = R 77 | image.segmented[,,2] = G 78 | image.segmented[,,3] = B 79 | 80 | out <- list(image.segmented, K) 81 | } 82 | 83 | if(kmeansOnAll == TRUE){ 84 | 85 | for(n in 1:length(image)){ 86 | 87 | imageX <- image[[n]] 88 | imageX <- raster::as.array(imageX) 89 | 90 | if(!is.null(maskToNA)){ 91 | imageX[imageX == maskToNA] <- NA 92 | } 93 | 94 | if(n==1){ 95 | dfTot = data.frame( 96 | red = matrix(imageX[,,1], ncol=1), 97 | green = matrix(imageX[,,2], ncol=1), 98 | blue = matrix(imageX[,,3], ncol=1) 99 | ) 100 | dfNrowTot <- c(nrow(dfTot)) 101 | } 102 | else{ 103 | df = data.frame( 104 | red = matrix(imageX[,,1], ncol=1), 105 | green = matrix(imageX[,,2], ncol=1), 106 | blue = matrix(imageX[,,3], ncol=1) 107 | ) 108 | dfNrow <- c(nrow(df)) 109 | dfNrowTot <- c(dfNrowTot, dfNrow) 110 | 111 | dfTot <- rbind(dfTot, df) 112 | 113 | } 114 | } 115 | 116 | if(is.null(startCenter)){ 117 | K = kmeans(na.omit(dfTot),k, nstart = 3) 118 | } 119 | else{ 120 | K = kmeans(na.omit(dfTot),startCenter) 121 | } 122 | 123 | dfTot$label <- NA 124 | suppressWarnings(dfTot$label[which(!is.na(dfTot$red))] <- K$cluster) 125 | 126 | # get the coloring 127 | 128 | colors = data.frame(label = 1:nrow(K$centers), 129 | R = K$centers[,"red"], 130 | G = K$centers[,"green"], 131 | B = K$centers[,"blue"]) 132 | 133 | # merge color codes on df 134 | 135 | dfTot$order = 1:nrow(dfTot) 136 | dfTot = merge(dfTot, colors, all = TRUE) 137 | dfTot = dfTot[order(dfTot$order),] 138 | dfTot$order = NULL 139 | 140 | 141 | 142 | # Reshape data frame back into an image 143 | s <- 1 144 | e <- 0 145 | image.segmented.list <- list() 146 | 147 | for(n in 1:length(image)){ 148 | 149 | imageX <- image[[n]] 150 | imageX <- raster::as.array(imageX) 151 | 152 | e <- e + dfNrowTot[n] 153 | 154 | df <- dfTot[c(s:e),] 155 | 156 | R = matrix(df$R, nrow=dim(imageX)[1]) 157 | G = matrix(df$G, nrow=dim(imageX)[1]) 158 | B = matrix(df$B, nrow=dim(imageX)[1]) 159 | 160 | image.segmented = array(dim=dim(imageX)) 161 | image.segmented[,,1] = R 162 | image.segmented[,,2] = G 163 | image.segmented[,,3] = B 164 | 165 | image.segmented.list[[names(image)[n]]] <- image.segmented 166 | 167 | s <- s + dfNrowTot[n] 168 | } 169 | out <- list(image.segmented.list, K) 170 | } 171 | return(out) 172 | } 173 | -------------------------------------------------------------------------------- /R/GMMImage.R: -------------------------------------------------------------------------------- 1 | #' \code{\link[ClusterR]{GMM}} clustering of image imported as a RasterStack. 2 | #' 3 | #' @param image Image imported as a RasterStack for clustering. 4 | #' @param k Integer for number of k clusters (default = 3). 5 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 6 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 7 | #' first (default = FALSE). 8 | #' 9 | #' @return List including the clustered \code{RasterSatck} returned as an array and object 10 | #' of class "\code{GMM}". 11 | #' 12 | #' @export 13 | #' @import sf 14 | #' @importFrom stats kmeans 15 | #' @importFrom ClusterR GMM predict_GMM 16 | #' @importFrom methods is 17 | 18 | GMMImage <- function(image, 19 | k = 5, 20 | maskToNA = NULL, 21 | kmeansOnAll = FALSE){ 22 | 23 | if(kmeansOnAll == FALSE){ 24 | 25 | if(is(image)[1] == "RasterStack"){ 26 | image <- raster::as.array(image) 27 | } 28 | 29 | df = data.frame( 30 | red = matrix(image[,,1], ncol=1), 31 | green = matrix(image[,,2], ncol=1), 32 | blue = matrix(image[,,3], ncol=1) 33 | ) 34 | 35 | # if(is.null(startCenter)){ 36 | # K = kmeans(na.omit(df),k, nstart = 3) 37 | # } 38 | # else{ 39 | # K = kmeans(na.omit(df),startCenter) 40 | # } 41 | 42 | gmm = GMM(na.omit(df), k, dist_mode = "maha_dist", seed_mode = "random_subset", km_iter = 0, em_iter = 10, verbose = F) 43 | 44 | pr = predict_GMM(na.omit(df), gmm$centroids, gmm$covariance_matrices, gmm$weights) 45 | 46 | df$label <- NA 47 | suppressWarnings(df$label[which(!is.na(df$red))] <- pr$cluster_labels) 48 | 49 | # df[is.na(df)] <- 0 50 | # df$label = K$cluster 51 | 52 | # Replace color of each pixel with mean RGB value of cluster 53 | 54 | # get the coloring 55 | 56 | colors = data.frame(label = 0:(nrow(gmm$centroids)-1), 57 | R = gmm$centroids[,1], 58 | G = gmm$centroids[,2], 59 | B = gmm$centroids[,3]) 60 | 61 | # merge color codes on df 62 | 63 | df$order = 1:nrow(df) 64 | df = merge(df, colors, all = TRUE) 65 | df = df[order(df$order),] 66 | df$order = NULL 67 | 68 | # Reshape data frame back into an image 69 | 70 | R = matrix(df$R, nrow=dim(image)[1]) 71 | G = matrix(df$G, nrow=dim(image)[1]) 72 | B = matrix(df$B, nrow=dim(image)[1]) 73 | 74 | image.segmented = array(dim=dim(image)) 75 | image.segmented[,,1] = R 76 | image.segmented[,,2] = G 77 | image.segmented[,,3] = B 78 | 79 | out <- list(image.segmented, gmm) 80 | } 81 | 82 | if(kmeansOnAll == TRUE){ 83 | 84 | for(n in 1:length(image)){ 85 | 86 | imageX <- image[[n]] 87 | imageX <- raster::as.array(imageX) 88 | 89 | if(!is.null(maskToNA)){ 90 | imageX[imageX == maskToNA] <- NA 91 | } 92 | 93 | if(n==1){ 94 | dfTot = data.frame( 95 | red = matrix(imageX[,,1], ncol=1), 96 | green = matrix(imageX[,,2], ncol=1), 97 | blue = matrix(imageX[,,3], ncol=1) 98 | ) 99 | dfNrowTot <- c(nrow(dfTot)) 100 | } 101 | else{ 102 | df = data.frame( 103 | red = matrix(imageX[,,1], ncol=1), 104 | green = matrix(imageX[,,2], ncol=1), 105 | blue = matrix(imageX[,,3], ncol=1) 106 | ) 107 | dfNrow <- c(nrow(df)) 108 | dfNrowTot <- c(dfNrowTot, dfNrow) 109 | 110 | dfTot <- rbind(dfTot, df) 111 | 112 | } 113 | } 114 | 115 | # if(is.null(startCenter)){ 116 | # K = kmeans(na.omit(dfTot),k, nstart = 3) 117 | # } 118 | # else{ 119 | # K = kmeans(na.omit(dfTot),startCenter) 120 | # } 121 | 122 | gmm = GMM(na.omit(dfTot), k, dist_mode = "maha_dist", seed_mode = "random_subset", km_iter = 0, em_iter = 10, verbose = F) 123 | 124 | pr = predict_GMM(na.omit(dfTot), gmm$centroids, gmm$covariance_matrices, gmm$weights) 125 | 126 | dfTot$label <- NA 127 | suppressWarnings(dfTot$label[which(!is.na(dfTot$red))] <- pr$cluster_labels) 128 | 129 | # get the coloring 130 | 131 | colors = data.frame(label = 0:(nrow(gmm$centroids)-1), 132 | R = gmm$centroids[,1], 133 | G = gmm$centroids[,2], 134 | B = gmm$centroids[,3]) 135 | 136 | # merge color codes on df 137 | 138 | dfTot$order = 1:nrow(dfTot) 139 | dfTot = merge(dfTot, colors, all = TRUE) 140 | dfTot = dfTot[order(dfTot$order),] 141 | dfTot$order = NULL 142 | 143 | 144 | 145 | # Reshape data frame back into an image 146 | s <- 1 147 | e <- 0 148 | image.segmented.list <- list() 149 | 150 | for(n in 1:length(image)){ 151 | 152 | imageX <- image[[n]] 153 | imageX <- raster::as.array(imageX) 154 | 155 | e <- e + dfNrowTot[n] 156 | 157 | df <- dfTot[c(s:e),] 158 | 159 | R = matrix(df$R, nrow=dim(imageX)[1]) 160 | G = matrix(df$G, nrow=dim(imageX)[1]) 161 | B = matrix(df$B, nrow=dim(imageX)[1]) 162 | 163 | image.segmented = array(dim=dim(imageX)) 164 | image.segmented[,,1] = R 165 | image.segmented[,,2] = G 166 | image.segmented[,,3] = B 167 | 168 | image.segmented.list[[names(image)[n]]] <- image.segmented 169 | 170 | s <- s + dfNrowTot[n] 171 | } 172 | out <- list(image.segmented.list, gmm) 173 | } 174 | return(out) 175 | } 176 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | #

patternize - An R package for quantifying color pattern variation patternize

2 | 3 | Quantifying variation in color patterns to study and compare the consistency of their expression necessitates the homologous alignment and color-based segmentation of images. Patternize is an R package that quantifies variation in color patterns as obtained from image data. Patternize defines homology between pattern positions across specimens either through fixed landmarks or image registration. Pattern identification is performed by categorizing the distribution of colors using either an RGB threshold or an unsupervised image segmentation. The quantification of the color patterns can be visualized as heat maps and compared between sets of samples. 4 | 5 | ```diff 6 | Please do not hesitate to contact me with any questions or suggestions! 7 | ``` 8 | 9 | Install patternize in R from CRAN (not up to date at this time!!): 10 | 11 | ``` 12 | install.packages("patternize") 13 | ``` 14 | 15 | Install patternize in R from GitHub using devtools: 16 | 17 | ``` 18 | install.packages("devtools") 19 | library(devtools) 20 | install_github("StevenVB12/patternize") 21 | # Morpho has committed a change that affects computeTransform used in 22 | # the patternize functions patLanRGB and patLanK (not available in CRAN) 23 | install_github("zarquon42b/Morpho") 24 | ``` 25 | 26 | Installation errors 27 | 28 | Some people have noted platform specific installation errors (mostly Mac). If you don't find your solution here, please contact me. 29 | 30 | ``` 31 | error: unable to load shared object 32 | '/Library/Frameworks/R.framework/Versions/3.4/Resources/library/rgl/libs/rgl.so' 33 | 34 | Solution: download XQuartz https://www.xquartz.org 35 | ``` 36 | 37 | 38 | 39 | 40 | For examples see package examples or https://github.com/StevenVB12/patternize-examples 41 | 42 | Workflow 43 | 44 | workflow

45 | 46 | Setting landmarks 47 | 48 | I set landmarks using the Fiji distribution of ImageJ (https://fiji.sc/): 49 | 50 | ``` 51 | Fiji 52 | > File > open (image) 53 | > Multi-point (make sure points are set in the same order for each sample) 54 | > Save As > XY coordinates 55 | ``` 56 | 57 | But you can also use (setting a resampleFactor > 0 speeds up things, but reduces resolution): 58 | 59 | ``` 60 | landmarkList <- sampleLandmarks(sampleList, resampleFactor = NULL, crop = c(0,0,0,0)) 61 | ``` 62 | 63 | If you are working with Heliconius or related butterflies, consider using this landmark scheme: 64 | 65 | landmarks_Heliconius_FW

66 | landmarks_Heliconius_HW

67 | 68 | Setting RGB value 69 | 70 | You can assign an RGB vector manually (e.g. RGB <- c(255,0,0) for red) or use: 71 | 72 | ``` 73 | RGB <- sampleRGB(image, resampleFactor = NULL, crop = c(0,0,0,0)) 74 | ``` 75 | 76 | Making cartoon for plotting (or masking) 77 | 78 | To plot a cartoon of the organism or trait of interest I use XY coordinates of an outline or lines obtained in the Fiji distribution of ImageJ (https://fiji.sc/). This is an annoying manual task, but if done precisely it can provide an outline or cartoon for any type of shape. The cartoon should be drawn for the reference (target) image when using image registration (patRegRGB or patRegK) or when using landmark transformation to a target image (patLanRGB or patLanK; transformRef = 'sample_ID'). When using transformRef = 'meanshape', the cartoon will also be transformed to the mean shape. 79 | 80 | outline 81 | 82 | ``` 83 | Fiji 84 | > File > open (image) 85 | > Polygon selections (draw outline) 86 | > Save As > XY coordinates 87 | ``` 88 | 89 | lines (same as setting landmarks) 90 | 91 | ``` 92 | Fiji 93 | > File > open (image) 94 | > Multi-point (draw lines by setting points) 95 | > Save As > XY coordinates 96 | ``` 97 | 98 | Calibrate images using ColorChecker 99 | 100 | The ColorChecker (Macbeth ColorChecker) is a color calibration target consisting of a framed arrangement of 24 squares of painted samples. The chart patches are selected to mimic those of natural objects and to have consistent color appearance under a variety of lighting conditions. By including this chart in an image, it can be used to calibrate images taken in different lightning conditions. 101 | 102 | ColorChecker calibrated

103 | 104 | You can calibrate images like this: 105 | 106 | ``` 107 | IDlist <- c('image1', 'image2') 108 | extension <- '.jpg' 109 | colorChecker(IDlist, extension) 110 | ``` 111 | 112 | The function is also available as a stand alone app: https://stevenvanbelleghem.shinyapps.io/shiny_colorchecker/ (see https://github.com/StevenVB12/shiny_ColorChecker) 113 | 114 | This calculates a second order polynomial regression between the observed and expected RGB values of the 24 ColorChecker patches and performs the calibration of the image. The function will ask you to define the corners of the ColorChecker like this (also works for images taken with a skew angle): 115 | 116 | ColorChecker corners

117 | 118 | -------------------------------------------------------------------------------- /man/patternize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patternize.R 3 | \docType{package} 4 | \name{patternize} 5 | \alias{patternize} 6 | \alias{patternize-package} 7 | \title{patternize - An R package for quantifying color pattern variation.} 8 | \description{ 9 | Quantifying variation in color patterns to study and compare the consistency of their expression 10 | necessitates the homologous alignment and color-based segmentation of images. Patternize is an R 11 | package that quantifies variation in color patterns as obtained from image data. Patternize 12 | defines homology between pattern positions across specimens either through fixed landmarks or 13 | image registration. Pattern identification is performed by categorizing the distribution of 14 | colors using either an RGB threshold or an unsupervised image segmentation. The quantification 15 | of the color patterns can be visualized as heat maps and compared between sets of samples. 16 | } 17 | \section{patternize main functions}{ 18 | 19 | 20 | The package has six main functions depending on how you want the alignment of the iamges and 21 | the color extraction to be performed. 22 | 23 | \code{patLanRGB} \cr 24 | Aligns images by transformations obtained from fixed landmarks and extracts colors using 25 | a predefined RGB values and cutoff value. 26 | 27 | \code{patLanK} \cr 28 | Aligns images by transformations obtained from fixed landmarks and extracts colors using 29 | k-means clustering. 30 | 31 | \code{patLanW} \cr 32 | Aligns images by transformations obtained from fixed landmarks and extracts color 33 | patterns by watershed segmentation using \code{\link[imager]{imager}} utilities. 34 | 35 | \code{patRegRGB} \cr 36 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 37 | registration and extracts colors using a predefined RGB values and cutoff value. 38 | 39 | \code{patRegK} \cr 40 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 41 | registration and extracts colors using k-means clustering. 42 | 43 | \code{patRegW} \cr 44 | Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 45 | registration and extracts color patterns by watershed segmentation using 46 | \code{\link[imager]{imager}} utilities. 47 | } 48 | 49 | \section{patternize preprocessing functions}{ 50 | 51 | 52 | The input for the main patternize functions are \code{RasterStack} objects and when landmark 53 | transformation is used, landmark arrays. 54 | 55 | \code{makeList} \cr 56 | This function returns a list of RasterStacks or a list of landmarks depending on the input 57 | provided. 58 | 59 | \code{sampleLandmarks} \cr 60 | Sample landmarks in an image. 61 | 62 | \code{lanArray} \cr 63 | This function creates a landmark array as used by \code{\link[Morpho]{procSym}} in the 64 | package \code{Morpho}. 65 | } 66 | 67 | \section{patternize postprocessing functions}{ 68 | 69 | 70 | \code{sumRaster} \cr 71 | This function sums the individual color pattern rasters as obtained by the main patternize 72 | functions. 73 | 74 | \code{plotHeat} \cr 75 | Plots the color pattern heatmaps from \code{sumRaster} output. 76 | 77 | \code{patPCA} \cr 78 | This function transforms the individual color pattern rasters as obtained by the main 79 | patternize functions to a dataframe of 0 and 1 values that can be used for Principal 80 | Component Analysis (\code{\link[stats]{prcomp}}). This function also allows to plot the 81 | analysis including a visualization of the shape changes along the axis. 82 | 83 | \code{patRDA} \cr 84 | This function transforms the individual color pattern rasters as obtained by the main 85 | patternize functions to a dataframe of 0 and 1 values that can be used for constrained 86 | Redundancy Analysis (\code{\link[vegan]{rda}}). This function also allows to plot the 87 | analysis including a visualization of the shape changes along the axis. 88 | 89 | \code{patArea} \cr 90 | This fucntion calculates the area in which the color pattern is expressed in each sample 91 | as the relative proportion using the provided outline of the considered trait or structure. 92 | } 93 | 94 | \section{patternize miscellaneous functions}{ 95 | 96 | 97 | \code{redRes} \cr 98 | Reduces the resolution of the \code{RasterStack} objects to speed up analysis. 99 | 100 | \code{kImage} \cr 101 | Performs k-means clustering of images. 102 | 103 | \code{sampleRGB} \cr 104 | Interactive function to sample RGB value from pixel or area in an image. 105 | 106 | \code{createTarget} \cr 107 | Creates an artificial target images using a provided outline that can be used for image 108 | registration (experimantal). 109 | 110 | \code{maskOutline} \cr 111 | Intersects a RasterStack with an outline. Everything outside of the outline will be removed 112 | from the raster. 113 | 114 | \code{colorChecker} \cr 115 | Calibrate images using ColorChecker. 116 | } 117 | 118 | \seealso{ 119 | \code{\link[raster]{raster}}, 120 | \code{\link[raster]{stack}}, 121 | \code{\link[Morpho]{procSym}}, 122 | \code{\link[Morpho]{computeTransform}}, 123 | \code{\link[RNiftyReg]{niftyreg}} 124 | \code{\link[imager]{imager}} 125 | 126 | \cite{Jon Clayden, Marc Modat, Benoit Presles, Thanasis Anthopoulos and Pankaj Daga (2017). 127 | RNiftyReg: Image Registration Using the 'NiftyReg' Library. R package version 2.5.0. 128 | https://CRAN.R-project.org/package=RNiftyReg} \cr 129 | 130 | \cite{Stefan Schlager (2016). Morpho: Calculations and Visualisations Related to Geometric 131 | Morphometrics. R package version 2.4.1.1. https://github.com/zarquon42b/Morpho} \cr 132 | 133 | \cite{Simon Barthelmé (2017). imager: Image processing library based on ‘CImg’. R package 134 | version 0.40.2. https://CRAN.R-project.org/package=imager} \cr 135 | } 136 | \author{ 137 | Steven M. Van Belleghem 138 | } 139 | -------------------------------------------------------------------------------- /R/patternize.R: -------------------------------------------------------------------------------- 1 | #' patternize - An R package for quantifying color pattern variation. 2 | #' 3 | #' Quantifying variation in color patterns to study and compare the consistency of their expression 4 | #' necessitates the homologous alignment and color-based segmentation of images. Patternize is an R 5 | #' package that quantifies variation in color patterns as obtained from image data. Patternize 6 | #' defines homology between pattern positions across specimens either through fixed landmarks or 7 | #' image registration. Pattern identification is performed by categorizing the distribution of 8 | #' colors using either an RGB threshold or an unsupervised image segmentation. The quantification 9 | #' of the color patterns can be visualized as heat maps and compared between sets of samples. 10 | #' 11 | #' @author Steven M. Van Belleghem 12 | #' 13 | #' @section patternize main functions: 14 | #' 15 | #' The package has six main functions depending on how you want the alignment of the iamges and 16 | #' the color extraction to be performed. 17 | #' 18 | #' \code{patLanRGB} \cr 19 | #' Aligns images by transformations obtained from fixed landmarks and extracts colors using 20 | #' a predefined RGB values and cutoff value. 21 | #' 22 | #' \code{patLanK} \cr 23 | #' Aligns images by transformations obtained from fixed landmarks and extracts colors using 24 | #' k-means clustering. 25 | #' 26 | #' \code{patLanW} \cr 27 | #' Aligns images by transformations obtained from fixed landmarks and extracts color 28 | #' patterns by watershed segmentation using \code{\link[imager]{imager}} utilities. 29 | #' 30 | #' \code{patRegRGB} \cr 31 | #' Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 32 | #' registration and extracts colors using a predefined RGB values and cutoff value. 33 | #' 34 | #' \code{patRegK} \cr 35 | #' Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 36 | #' registration and extracts colors using k-means clustering. 37 | #' 38 | #' \code{patRegW} \cr 39 | #' Aligns images using \code{\link[RNiftyReg]{niftyreg}} utilities for automated image 40 | #' registration and extracts color patterns by watershed segmentation using 41 | #' \code{\link[imager]{imager}} utilities. 42 | #' 43 | #' 44 | #' @section patternize preprocessing functions: 45 | #' 46 | #' The input for the main patternize functions are \code{RasterStack} objects and when landmark 47 | #' transformation is used, landmark arrays. 48 | #' 49 | #' \code{makeList} \cr 50 | #' This function returns a list of RasterStacks or a list of landmarks depending on the input 51 | #' provided. 52 | #' 53 | #' \code{sampleLandmarks} \cr 54 | #' Sample landmarks in an image. 55 | #' 56 | #' \code{lanArray} \cr 57 | #' This function creates a landmark array as used by \code{\link[Morpho]{procSym}} in the 58 | #' package \code{Morpho}. 59 | #' 60 | #' 61 | #' 62 | #' @section patternize postprocessing functions: 63 | #' 64 | #' \code{sumRaster} \cr 65 | #' This function sums the individual color pattern rasters as obtained by the main patternize 66 | #' functions. 67 | #' 68 | #' \code{plotHeat} \cr 69 | #' Plots the color pattern heatmaps from \code{sumRaster} output. 70 | #' 71 | #' \code{patPCA} \cr 72 | #' This function transforms the individual color pattern rasters as obtained by the main 73 | #' patternize functions to a dataframe of 0 and 1 values that can be used for Principal 74 | #' Component Analysis (\code{\link[stats]{prcomp}}). This function also allows to plot the 75 | #' analysis including a visualization of the shape changes along the axis. 76 | #' 77 | #' \code{patRDA} \cr 78 | #' This function transforms the individual color pattern rasters as obtained by the main 79 | #' patternize functions to a dataframe of 0 and 1 values that can be used for constrained 80 | #' Redundancy Analysis (\code{\link[vegan]{rda}}). This function also allows to plot the 81 | #' analysis including a visualization of the shape changes along the axis. 82 | #' 83 | #' \code{patArea} \cr 84 | #' This fucntion calculates the area in which the color pattern is expressed in each sample 85 | #' as the relative proportion using the provided outline of the considered trait or structure. 86 | #' 87 | #' 88 | #' 89 | #' @section patternize miscellaneous functions: 90 | #' 91 | #' \code{redRes} \cr 92 | #' Reduces the resolution of the \code{RasterStack} objects to speed up analysis. 93 | #' 94 | #' \code{kImage} \cr 95 | #' Performs k-means clustering of images. 96 | #' 97 | #' \code{sampleRGB} \cr 98 | #' Interactive function to sample RGB value from pixel or area in an image. 99 | #' 100 | #' \code{createTarget} \cr 101 | #' Creates an artificial target images using a provided outline that can be used for image 102 | #' registration (experimantal). 103 | #' 104 | #' \code{maskOutline} \cr 105 | #' Intersects a RasterStack with an outline. Everything outside of the outline will be removed 106 | #' from the raster. 107 | #' 108 | #' \code{colorChecker} \cr 109 | #' Calibrate images using ColorChecker. 110 | #' 111 | #' 112 | #' @seealso 113 | #' \code{\link[raster]{raster}}, 114 | #' \code{\link[raster]{stack}}, 115 | #' \code{\link[Morpho]{procSym}}, 116 | #' \code{\link[Morpho]{computeTransform}}, 117 | #' \code{\link[RNiftyReg]{niftyreg}} 118 | #' \code{\link[imager]{imager}} 119 | #' 120 | #' \cite{Jon Clayden, Marc Modat, Benoit Presles, Thanasis Anthopoulos and Pankaj Daga (2017). 121 | #' RNiftyReg: Image Registration Using the 'NiftyReg' Library. R package version 2.5.0. 122 | #' https://CRAN.R-project.org/package=RNiftyReg} \cr 123 | #' 124 | #' \cite{Stefan Schlager (2016). Morpho: Calculations and Visualisations Related to Geometric 125 | #' Morphometrics. R package version 2.4.1.1. https://github.com/zarquon42b/Morpho} \cr 126 | #' 127 | #' \cite{Simon Barthelmé (2017). imager: Image processing library based on ‘CImg’. R package 128 | #' version 0.40.2. https://CRAN.R-project.org/package=imager} \cr 129 | #' 130 | #' @docType package 131 | #' @name patternize 132 | #' @aliases patternize-package 133 | NULL 134 | -------------------------------------------------------------------------------- /man/patRDA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patRDA.R 3 | \name{patRDA} 4 | \alias{patRDA} 5 | \title{This function transforms the individual color pattern rasters as obtained by the main 6 | patternize functions to a dataframe of 0 and 1 values that can be used for constrained 7 | Redundancy Analysis (RDA) (\code{\link[vegan]{rda}}). This function also allows to plot the 8 | analysis including a visualization of the shape changes along the axis.} 9 | \usage{ 10 | patRDA( 11 | rList, 12 | popList, 13 | colList, 14 | symbolList = NULL, 15 | rListPredict = NULL, 16 | popListPredict = NULL, 17 | colListPredict = NULL, 18 | symbolListPredict = NULL, 19 | plot = FALSE, 20 | plotType = "points", 21 | plotChanges = FALSE, 22 | PCx = 1, 23 | PCy = 2, 24 | plotCartoon = FALSE, 25 | refShape = NULL, 26 | outline = NULL, 27 | lines = NULL, 28 | landList = NULL, 29 | adjustCoords = FALSE, 30 | crop = c(0, 0, 0, 0), 31 | flipRaster = NULL, 32 | flipOutline = NULL, 33 | imageList = NULL, 34 | cartoonID = NULL, 35 | colpalette = NULL, 36 | normalized = NULL, 37 | cartoonOrder = "above", 38 | lineOrder = "above", 39 | cartoonCol = "gray", 40 | cartoonFill = NULL, 41 | plotLandmarks = FALSE, 42 | landCol = "black", 43 | zlim = c(-1, 1), 44 | legendTitle = "Predicted", 45 | xlab = "", 46 | ylab = "", 47 | main = "" 48 | ) 49 | } 50 | \arguments{ 51 | \item{rList}{List of raster objects.} 52 | 53 | \item{popList}{List of vectors including sampleIDs for each population.} 54 | 55 | \item{colList}{List of colors for each population.} 56 | 57 | \item{symbolList}{List with graphical plotting symbols (default = NULL).} 58 | 59 | \item{rListPredict}{List of raster objects to predict into DFA space (default = NULL).} 60 | 61 | \item{popListPredict}{List of vectors including sampleIDs for each set of predict samples 62 | (default = NULL). Note to that this also has to be a list if only one population is included.} 63 | 64 | \item{colListPredict}{List of colors for each set of predict samples (default = NULL).} 65 | 66 | \item{symbolListPredict}{List with graphical plotting symbols for predict sets (default = NULL).} 67 | 68 | \item{plot}{Whether to plot the PCA analysis (default = FALSE).} 69 | 70 | \item{plotType}{Plot 'points' or sample 'labels' (default = 'points')} 71 | 72 | \item{plotChanges}{Wether to include plots of the changes along the PC axis (default = FALSE).} 73 | 74 | \item{PCx}{PC axis to be presented for x-axis (default PC1).} 75 | 76 | \item{PCy}{PC axis to be presented for y-axis (default PC2).} 77 | 78 | \item{plotCartoon}{Whether to plot a cartoon. This cartoon should be drawn on one of the 79 | samples used in the analysis.} 80 | 81 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 82 | registration analysis) or 'mean' if the images were transformed to a mean shape (only for 83 | meanshape when using landmark transformation)} 84 | 85 | \item{outline}{xy coordinates that define outline.} 86 | 87 | \item{lines}{list of files with xy coordinates of line objects to be added to cartoon.} 88 | 89 | \item{landList}{Landmark landmarkList.} 90 | 91 | \item{adjustCoords}{Adjust landmark coordinates.} 92 | 93 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop 94 | the original image used in landmark or registration analysis.} 95 | 96 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency 97 | between raster and outline coordinates).} 98 | 99 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 100 | 101 | \item{imageList}{List of image should be given if one wants to flip the outline or adjust 102 | landmark coordinates.} 103 | 104 | \item{cartoonID}{ID of the sample for which the cartoon was drawn.} 105 | 106 | \item{colpalette}{Vector of colors for color palette 107 | (default = c("white","lightblue","blue","green", "yellow","red"))} 108 | 109 | \item{normalized}{Set this to true in case the summed rasters are already devided by the 110 | sample number.} 111 | 112 | \item{cartoonOrder}{Whether to plot the cartoon outline 'above' or 'under' the pattern raster 113 | (default = 'above'). Set to 'under' for filled outlines.} 114 | 115 | \item{lineOrder}{Whether to plot the cartoon lines 'above' or 'under' the pattern raster 116 | (default = 'above').} 117 | 118 | \item{cartoonCol}{Outline and line color for cartoon (deafault = 'gray').} 119 | 120 | \item{cartoonFill}{Fill color for outline of cartoon (default = NULL).} 121 | 122 | \item{plotLandmarks}{Whether to plot the landmarks from the target image or mean shape 123 | landmarks (default = FALSE).} 124 | 125 | \item{landCol}{Color for plotting landmarks (default = 'black').} 126 | 127 | \item{zlim}{z-axis limit (default = c(0,1))} 128 | 129 | \item{legendTitle}{Title of the raster legend (default = 'Proportion')} 130 | 131 | \item{xlab}{Optional x-axis label.} 132 | 133 | \item{ylab}{Optional y-axis label.} 134 | 135 | \item{main}{Optional main title.} 136 | } 137 | \value{ 138 | If plot = TRUE: List including a [1] dataframe of the binary raster values that can be used for 139 | discriminant function analysis, [2] a dataframe of sample IDs and specified population 140 | colors and [3] lda results. if rListPredict not empty: [4] class prediction of samples. If plot = FALSE: 141 | lda result only. 142 | } 143 | \description{ 144 | This function transforms the individual color pattern rasters as obtained by the main 145 | patternize functions to a dataframe of 0 and 1 values that can be used for constrained 146 | Redundancy Analysis (RDA) (\code{\link[vegan]{rda}}). This function also allows to plot the 147 | analysis including a visualization of the shape changes along the axis. 148 | } 149 | \examples{ 150 | data(rasterList_lanRGB) 151 | 152 | pop1 <- c('BC0077','BC0071') 153 | pop2 <- c('BC0050','BC0049','BC0004') 154 | popList <- list(pop1, pop2) 155 | colList <- c("red", "blue") 156 | 157 | pcaOut <- patRDA(rasterList_lanRGB, popList, colList, plot = TRUE) 158 | 159 | } 160 | \seealso{ 161 | \code{\link[MASS]{lda}} 162 | } 163 | -------------------------------------------------------------------------------- /R/patK.R: -------------------------------------------------------------------------------- 1 | #' Extract colors using k-means clustering (for pre-aligned images). 2 | #' 3 | #' @param sampleList List of RasterStack objects. 4 | #' @param k Integere for defining number of k-means clusters (default = 3). 5 | #' @param fixedStartCenter Specify a dataframe with start centers for k-means clustering. 6 | #' @param resampleFactor Integer for downsampling used by \code{\link{redRes}}. 7 | #' @param maskOutline When outline is specified, everything outside of the outline will be masked for 8 | #' the color extraction (default = NULL). 9 | #' @param plot Whether to plot transformed color patterns while processing (default = FALSE). 10 | #' @param focal Whether to perform Gaussian blurring (default = FALSE). 11 | #' @param sigma Size of sigma for Gaussian blurring (default = 3). 12 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 13 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 14 | #' first (default = FALSE). 15 | #' 16 | #' @return List of summed raster for each k-means cluster objects. 17 | #' 18 | #' 19 | #' @export 20 | #' @import raster 21 | #' @importFrom utils capture.output 22 | 23 | patK <- function(sampleList, 24 | k = 3, 25 | fixedStartCenter = NULL, 26 | resampleFactor = NULL, 27 | maskOutline = NULL, 28 | plot = FALSE, 29 | focal = FALSE, 30 | sigma = 3, 31 | maskToNA = NULL, 32 | kmeansOnAll = FALSE){ 33 | 34 | rasterList <- list() 35 | 36 | if(is.null(fixedStartCenter)){ 37 | startCenter = NULL 38 | } 39 | 40 | if(!is.null(fixedStartCenter)){ 41 | startCenter <- fixedStartCenter 42 | print('Fixed start centers:') 43 | print(startCenter) 44 | } 45 | 46 | for(n in 1:length(sampleList)){ 47 | 48 | image <- sampleList[[n]] 49 | extRasterOr <- raster::extent(image) 50 | 51 | if(!is.null(resampleFactor)){ 52 | image <- redRes(image, resampleFactor) 53 | } 54 | 55 | if(focal){ 56 | gf <- focalWeight(image, sigma, "Gauss") 57 | 58 | rrr1 <- raster::focal(image[[1]], gf) 59 | rrr2 <- raster::focal(image[[2]], gf) 60 | rrr3 <- raster::focal(image[[3]], gf) 61 | 62 | image <- raster::stack(rrr1, rrr2, rrr3) 63 | } 64 | 65 | if(!is.null(maskOutline))( 66 | image <- maskOutline(image, maskOutline, refShape = 'target', flipOutline = 'y', imageList = sampleList) 67 | ) 68 | 69 | if(!is.null(maskToNA)){ 70 | image[image == maskToNA] <- NA 71 | 72 | } 73 | 74 | # k-means clustering of image 75 | 76 | if(kmeansOnAll == FALSE){ 77 | 78 | imageKmeans <- tryCatch(kImage(raster::as.array(image), k, startCenter, maskToNA), 79 | error = function(err) { 80 | print(paste('sample', names(sampleList)[n], 'k-clustering failed and skipped', sep = ' ')) 81 | return(NULL) 82 | }) 83 | # imageKmeans <- kImage(raster::as.array(image), k, startCenter) 84 | if(is.null(imageKmeans)){next} 85 | 86 | image.segmented <- imageKmeans[[1]] 87 | K <- imageKmeans[[2]] 88 | 89 | if(all(c(n==1, is.null(fixedStartCenter)))){ 90 | startCenter <- K$centers 91 | print('start centers of first image:') 92 | print(startCenter) 93 | } 94 | 95 | if(plot){ 96 | image.segmented[is.na(image.segmented)] <- 0 97 | x <- image.segmented/255 98 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 99 | uniqueCols <- unique(cols) 100 | x2 <- match(cols, uniqueCols) 101 | dim(x2) <- dim(x)[1:2] 102 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 103 | } 104 | 105 | 106 | e=0 107 | 108 | rasterListInd <- list() 109 | 110 | for(i in 1:nrow(K$centers)){ 111 | 112 | e=e+1 113 | 114 | rgb <- K$centers[i,] 115 | 116 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 117 | mapR <- raster::raster(map) 118 | raster::extent(mapR) <- extRasterOr 119 | 120 | rasterListInd[[e]] <- mapR 121 | 122 | 123 | rasterList[[names(sampleList)[n]]] <- rasterListInd 124 | } 125 | 126 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 127 | } 128 | } 129 | 130 | if(kmeansOnAll == TRUE){ 131 | 132 | imageKmeans <- kImage(sampleList, k, startCenter, maskToNA, kmeansOnAll) 133 | 134 | images.segmented <- imageKmeans[[1]] 135 | K <- imageKmeans[[2]] 136 | 137 | # if(!is.null(fixedStartCenter)){ 138 | # print('start centers of all images:') 139 | # print(startCenter) 140 | # } 141 | startCenter <- K$centers 142 | print('final k-means centers of all images:') 143 | print(startCenter) 144 | 145 | 146 | for(n in 1:length(images.segmented)){ 147 | 148 | image.segmented <- images.segmented[[n]] 149 | 150 | if(plot){ 151 | image.segmented[is.na(image.segmented)] <- 0 152 | x <- image.segmented/255 153 | cols <- rgb(x[,,1], x[,,2], x[,,3], maxColorValue=1) 154 | uniqueCols <- unique(cols) 155 | x2 <- match(cols, uniqueCols) 156 | dim(x2) <- dim(x)[1:2] 157 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 158 | } 159 | 160 | e=0 161 | 162 | rasterListInd <- list() 163 | 164 | for(i in 1:nrow(K$centers)){ 165 | 166 | e=e+1 167 | 168 | rgb <- K$centers[i,] 169 | 170 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 171 | mapR <- raster::raster(map) 172 | raster::extent(mapR) <- extRasterOr 173 | 174 | rasterListInd[[e]] <- mapR 175 | 176 | 177 | rasterList[[names(sampleList)[n]]] <- rasterListInd 178 | } 179 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 180 | } 181 | 182 | } 183 | return(rasterList) 184 | 185 | } 186 | 187 | -------------------------------------------------------------------------------- /R/maskOutline.R: -------------------------------------------------------------------------------- 1 | #' Intersects a RasterStack with an outline. Everything outside of the outline will be removed 2 | #' from the raster. 3 | #' 4 | #' @param RasterStack RasterStack to be masked. 5 | #' @param outline xy coordinates that define outline. 6 | #' @param refShape This can be 'target' in case the reference shape is a single sample (for 7 | #' registration analysis) or 'mean' if the images were transformed to a mean shape (only 8 | #' for meanshape when using landmark transformation) 9 | #' @param landList Landmark list to be given when type = 'mean'. 10 | #' @param adjustCoords Adjust landmark coordinates in case they are reversed compared to 11 | #' pixel coordinates (default = FALSE). 12 | #' @param cartoonID ID of the sample for which the cartoon was drawn. Only has to be given when 13 | #' refShape is 'mean'. 14 | #' @param IDlist List of sample IDs should be specified when refShape is 'mean'. 15 | #' @param crop Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to 16 | #' crop the original image used in landmark or registration analysis. 17 | #' @param flipRaster Whether to flip raster along xy axis (in case there is an inconsistency 18 | #' between raster and outline coordinates). 19 | #' @param flipOutline Whether to flip plot along x, y or xy axis. 20 | #' @param imageList List of image as obtained from \code{\link[patternize]{makeList}} should 21 | #' be given if one wants to flip the outline or adjust landmark coordinates. 22 | #' @param maskColor Color the masked area gets. Set to 0 for black (default) or 255 for white. 23 | #' @param inverse If TRUE, areas withing the outline will be masked. 24 | #' 25 | #' @examples 26 | #' 27 | #' \dontrun{ 28 | #' data(imageList) 29 | #' outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 30 | #' '/BC0077_outline.txt', sep=''), header = FALSE) 31 | #' 32 | #' masked <- maskOutline(imageList[[1]], outline_BC0077, refShape = 'target', flipOutline = 'y') 33 | #' } 34 | #' 35 | #' @export 36 | #' @import raster 37 | #' @importFrom utils capture.output 38 | 39 | maskOutline <-function(RasterStack, 40 | outline, 41 | refShape, 42 | landList = NULL, 43 | adjustCoords = FALSE, 44 | cartoonID = NULL, 45 | IDlist = NULL, 46 | crop = c(0,0,0,0), 47 | flipRaster = NULL, 48 | flipOutline = NULL, 49 | imageList = NULL, 50 | maskColor = 0, 51 | inverse = FALSE){ 52 | 53 | if(is.list(imageList)){ 54 | 55 | imageEx <- raster::extent(imageList[[1]]) 56 | } 57 | else{ 58 | imageEx <- raster::extent(imageList) 59 | } 60 | if(!is.null(cartoonID)){ 61 | imageEx <- raster::extent(imageList[[cartoonID]]) 62 | } 63 | 64 | if(any(c(!is.null(flipOutline), !is.null(flipRaster)))){ 65 | 66 | if(refShape != 'mean'){ 67 | 68 | outline[,2] <- outline[,2] - crop[3] 69 | 70 | } 71 | } 72 | 73 | if(refShape != 'mean'){ 74 | 75 | 76 | if(all(c(!is.null(flipOutline), flipOutline == 'y'))){ 77 | outline[,2] <- outline[,2] + crop[3] 78 | } 79 | if(all(c(!is.null(flipOutline), flipOutline == 'xy'))){ 80 | outline[,2] <- outline[,2] + crop[3] 81 | } 82 | 83 | if(all(c(is.null(flipOutline), !is.null(flipRaster)))){ 84 | outline[,2] <- outline[,2] + ((crop[3] - imageEx[3]) - (imageEx[4] - crop[4])) + crop[3] 85 | } 86 | if(all(c(!is.null(flipOutline), flipOutline == 'x'))){ 87 | outline[,2] <- outline[,2] + ((crop[3] - imageEx[3]) - (imageEx[4] - crop[4])) + crop[3] 88 | } 89 | 90 | if(!is.null(flipOutline)){ 91 | 92 | if(flipOutline == 'x'){ 93 | 94 | outline[,1] <- imageEx[2] - outline[,1] + (crop[1] - imageEx[1]) - (imageEx[2] - crop[2]) 95 | 96 | } 97 | 98 | if(flipOutline == 'y'){ 99 | 100 | outline[,2] <- imageEx[4] - outline[,2] 101 | 102 | } 103 | 104 | if(flipOutline == 'xy'){ 105 | 106 | outline[,1] <- imageEx[2] - outline[,1] + (crop[1] - imageEx[1]) - (imageEx[2] - crop[2]) 107 | outline[,2] <- imageEx[4] - outline[,2] 108 | 109 | } 110 | } 111 | } 112 | 113 | if(refShape == 'mean'){ 114 | 115 | indx <- which(IDlist == cartoonID) 116 | invisible(capture.output(landArray <- lanArray(landList, adjustCoords, imageList))) 117 | 118 | if(adjustCoords){ 119 | 120 | extPicture <- raster::extent(imageList[[indx]]) 121 | outline[,2] <- extPicture[4]-outline[,2] 122 | } 123 | 124 | invisible(capture.output(transformed <- Morpho::procSym(landArray))) 125 | 126 | 127 | invisible(capture.output(cartoonLandTrans <- Morpho::computeTransform(transformed$mshape, 128 | as.matrix(landArray[,,indx]), type="tps"))) 129 | 130 | if(!is.null(flipOutline)){ 131 | 132 | if(flipOutline == 'x'){ 133 | outline[,1] = imageEx[2] - outline[,1] + imageEx[1] 134 | 135 | 136 | } 137 | 138 | if(flipOutline == 'y'){ 139 | outline[,2] = imageEx[4] - outline[,2] + imageEx[3] 140 | 141 | } 142 | 143 | if(flipOutline == 'xy'){ 144 | outline[,1] = imageEx[2] - outline[,1] + imageEx[1] 145 | outline[,2] = imageEx[4] - outline[,2] + imageEx[3] 146 | 147 | } 148 | } 149 | 150 | outline <- Morpho::applyTransform(as.matrix(outline), cartoonLandTrans) 151 | 152 | 153 | } 154 | 155 | 156 | poly <- sp::Polygons(list(sp::Polygon(outline)),paste("r")) 157 | 158 | polyList <- c(poly) 159 | polyNames <- c(paste("r")) 160 | sr <- sp::SpatialPolygons(polyList) 161 | srdf <- sp::SpatialPolygonsDataFrame(sr, data.frame(1:length(polyNames), row.names=polyNames)) 162 | 163 | imageExr <- raster::extent(RasterStack) 164 | r <- raster::raster(imageExr, nrow=dim(RasterStack)[1], ncol=dim(RasterStack)[2]) 165 | rr <- raster::rasterize(srdf, r) 166 | 167 | if(!is.null(flipRaster)){ 168 | if(flipRaster == 'x'){ 169 | RasterStack <- raster::flip(RasterStack,'x') 170 | } 171 | if(flipRaster == 'y'){ 172 | RasterStack <- raster::flip(RasterStack,'y') 173 | } 174 | if(flipRaster == 'xy'){ 175 | RasterStack <- raster::flip(RasterStack,'x') 176 | RasterStack <- raster::flip(RasterStack,'y') 177 | } 178 | } 179 | 180 | RasterStack <- raster::mask(RasterStack, rr, inverse = inverse) 181 | RasterStack[is.na(RasterStack)] <- maskColor 182 | 183 | return(RasterStack) 184 | } 185 | 186 | 187 | 188 | 189 | 190 | 191 | -------------------------------------------------------------------------------- /R/patK_HSV.R: -------------------------------------------------------------------------------- 1 | #' Extract colors using k-means clustering (for pre-aligned images). 2 | #' 3 | #' @param sampleList List of RasterStack objects. 4 | #' @param k Integere for defining number of k-means clusters (default = 3). 5 | #' @param fixedStartCenter Specify a dataframe with start centers for k-means clustering. 6 | #' @param resampleFactor Integer for downsampling used by \code{\link{redRes}}. 7 | #' @param maskOutline When outline is specified, everything outside of the outline will be masked for 8 | #' the color extraction (default = NULL). 9 | #' @param plot Whether to plot transformed color patterns while processing (default = FALSE). 10 | #' @param focal Whether to perform Gaussian blurring (default = FALSE). 11 | #' @param sigma Size of sigma for Gaussian blurring (default = 3). 12 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 13 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 14 | #' first (default = FALSE). 15 | #' @param ignoreHSVvalue Whether to ignore the HSV value (~darkness). 16 | #' 17 | #' @return List of summed raster for each k-means cluster objects. 18 | #' 19 | #' 20 | #' @export 21 | #' @import raster 22 | #' @importFrom utils capture.output 23 | #' @importFrom grDevices hsv rgb2hsv 24 | 25 | patK_HSV <- function(sampleList, 26 | k = 3, 27 | fixedStartCenter = NULL, 28 | resampleFactor = NULL, 29 | maskOutline = NULL, 30 | plot = FALSE, 31 | focal = FALSE, 32 | sigma = 3, 33 | maskToNA = NULL, 34 | kmeansOnAll = FALSE, 35 | ignoreHSVvalue = FALSE){ 36 | 37 | rasterList <- list() 38 | 39 | if(is.null(fixedStartCenter)){ 40 | startCenter = NULL 41 | } 42 | 43 | if(!is.null(fixedStartCenter)){ 44 | startCenter <- fixedStartCenter 45 | print('Fixed start centers:') 46 | print(startCenter) 47 | } 48 | 49 | for(n in 1:length(sampleList)){ 50 | 51 | image <- sampleList[[n]] 52 | 53 | 54 | 55 | extRasterOr <- raster::extent(image) 56 | 57 | if(!is.null(resampleFactor)){ 58 | image <- redRes(image, resampleFactor) 59 | } 60 | 61 | if(focal){ 62 | gf <- focalWeight(image, sigma, "Gauss") 63 | 64 | rrr1 <- raster::focal(image[[1]], gf) 65 | rrr2 <- raster::focal(image[[2]], gf) 66 | rrr3 <- raster::focal(image[[3]], gf) 67 | 68 | image <- raster::stack(rrr1, rrr2, rrr3) 69 | } 70 | 71 | if(!is.null(maskOutline))( 72 | image <- maskOutline(image, maskOutline, refShape = 'target', flipOutline = 'y', imageList = sampleList) 73 | ) 74 | 75 | 76 | 77 | # k-means clustering of image 78 | 79 | if(kmeansOnAll == FALSE){ 80 | 81 | # convert RGB values to HSV values 82 | 83 | image <- raster::overlay(image, fun = rgb2hsv) 84 | 85 | if(!is.null(maskToNA)){ 86 | image[image == maskToNA] <- NA 87 | 88 | } 89 | 90 | imageKmeans <- kImageHSV(raster::as.array(image), k, startCenter, ignoreHSVvalue = ignoreHSVvalue) 91 | 92 | imageKmeans <- tryCatch(kImageHSV(raster::as.array(image), k, startCenter, ignoreHSVvalue = ignoreHSVvalue), 93 | error = function(err) { 94 | print(paste('sample', names(sampleList)[n], 'k-clustering failed and skipped', sep = ' ')) 95 | return(NULL) 96 | }) 97 | # imageKmeans <- kImage(raster::as.array(image), k, startCenter) 98 | if(is.null(imageKmeans)){next} 99 | 100 | image.segmented <- imageKmeans[[1]] 101 | K <- imageKmeans[[2]] 102 | 103 | if(all(c(n==1, is.null(fixedStartCenter)))){ 104 | startCenter <- K$centers 105 | print('start centers of first image:') 106 | print(startCenter) 107 | } 108 | 109 | if(plot){ 110 | image.segmented[is.na(image.segmented)] <- 0 111 | x <- image.segmented 112 | cols <- hsv(x[,,1], x[,,2], x[,,3]) 113 | uniqueCols <- unique(cols) 114 | x2 <- match(cols, uniqueCols) 115 | dim(x2) <- dim(x)[1:2] 116 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 117 | } 118 | 119 | 120 | e=0 121 | 122 | rasterListInd <- list() 123 | 124 | for(i in 1:nrow(K$centers)){ 125 | 126 | e=e+1 127 | 128 | if(ignoreHSVvalue == FALSE){ 129 | rgb <- K$centers[i,] 130 | } 131 | else{ 132 | rgb <- K$centers[i,] 133 | rgb <- c(rgb, 1) 134 | } 135 | 136 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 137 | mapR <- raster::raster(map) 138 | raster::extent(mapR) <- extRasterOr 139 | 140 | rasterListInd[[e]] <- mapR 141 | 142 | 143 | rasterList[[names(sampleList)[n]]] <- rasterListInd 144 | } 145 | 146 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 147 | } 148 | } 149 | 150 | if(kmeansOnAll == TRUE){ 151 | 152 | imageKmeans <- kImageHSV(sampleList, k, startCenter, maskToNA, kmeansOnAll, ignoreHSVvalue) 153 | 154 | images.segmented <- imageKmeans[[1]] 155 | K <- imageKmeans[[2]] 156 | 157 | # if(!is.null(fixedStartCenter)){ 158 | # print('start centers of all images:') 159 | # print(startCenter) 160 | # } 161 | startCenter <- K$centers 162 | print('final k-means centers of all images:') 163 | print(startCenter) 164 | 165 | 166 | for(n in 1:length(images.segmented)){ 167 | 168 | image.segmented <- images.segmented[[n]] 169 | 170 | if(plot){ 171 | image.segmented[is.na(image.segmented)] <- 0 172 | x <- image.segmented 173 | cols <- hsv(x[,,1], x[,,2], x[,,3]) 174 | uniqueCols <- unique(cols) 175 | x2 <- match(cols, uniqueCols) 176 | dim(x2) <- dim(x)[1:2] 177 | raster::image(t(apply(x2, 2, rev)), col=uniqueCols, yaxt='n', xaxt='n') 178 | } 179 | 180 | 181 | e=0 182 | 183 | rasterListInd <- list() 184 | 185 | for(i in 1:nrow(K$centers)){ 186 | 187 | e=e+1 188 | 189 | if(ignoreHSVvalue == FALSE){ 190 | rgb <- K$centers[i,] 191 | } 192 | else{ 193 | rgb <- K$centers[i,] 194 | rgb <- c(rgb, 0.5) 195 | } 196 | 197 | map <- apply(image.segmented, 1:2, function(x) all(x-rgb == 0)) 198 | mapR <- raster::raster(map) 199 | raster::extent(mapR) <- extRasterOr 200 | 201 | rasterListInd[[e]] <- mapR 202 | 203 | 204 | rasterList[[names(sampleList)[n]]] <- rasterListInd 205 | } 206 | print(paste('sample', names(sampleList)[n], 'done and added to rasterList', sep=' ')) 207 | } 208 | 209 | } 210 | return(rasterList) 211 | 212 | } 213 | 214 | -------------------------------------------------------------------------------- /man/patPCA.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/patPCA.R 3 | \name{patPCA} 4 | \alias{patPCA} 5 | \title{This function transforms the individual color pattern rasters as obtained by the main 6 | patternize functions to a dataframe of 0 and 1 values that can be used for Principal 7 | Component Analysis (\code{\link[stats]{prcomp}}). This function also allows to plot the 8 | analysis including a visualization of the shape changes along the axis. Pixel values 9 | are predicted by multiplying the rotation matrix (eigenvectors) with a vector that has 10 | the same length as the number of rows in the rotation matrix and in which all values are 11 | set to zero except for the PC value for which we want to predict the pixel values.} 12 | \usage{ 13 | patPCA( 14 | rList, 15 | popList, 16 | colList, 17 | symbolList = NULL, 18 | rListPredict = NULL, 19 | popListPredict = NULL, 20 | colListPredict = NULL, 21 | pcaListPredict = NULL, 22 | pcaPopListPredict = NULL, 23 | pcaColPredict = "red", 24 | symbolListPredict = NULL, 25 | plot = FALSE, 26 | plotType = "points", 27 | plotChanges = FALSE, 28 | PCx = 1, 29 | PCy = 2, 30 | plotCartoon = FALSE, 31 | refShape = NULL, 32 | outline = NULL, 33 | lines = NULL, 34 | landList = NULL, 35 | adjustCoords = FALSE, 36 | crop = c(0, 0, 0, 0), 37 | flipRaster = NULL, 38 | flipOutline = NULL, 39 | imageList = NULL, 40 | cartoonID = NULL, 41 | refImage = NULL, 42 | colpalette = NULL, 43 | normalized = NULL, 44 | cartoonOrder = "above", 45 | lineOrder = "above", 46 | cartoonCol = "gray", 47 | cartoonFill = NULL, 48 | plotLandmarks = FALSE, 49 | landCol = "black", 50 | zlim = c(-1, 1), 51 | legendTitle = "Predicted", 52 | xlab = "", 53 | ylab = "", 54 | main = "", 55 | ... 56 | ) 57 | } 58 | \arguments{ 59 | \item{rList}{List of raster objects.} 60 | 61 | \item{popList}{List of vectors including sampleIDs for each population.} 62 | 63 | \item{colList}{List of colors for each population.} 64 | 65 | \item{symbolList}{List with graphical plotting symbols (default = NULL).} 66 | 67 | \item{rListPredict}{List of raster objects to predict into PCA space (default = NULL).} 68 | 69 | \item{popListPredict}{List of vectors including sampleIDs for each set of predict samples 70 | (default = NULL). Note to that this also has to be a list if only one population is included.} 71 | 72 | \item{colListPredict}{List of colors for each set of predict samples (default = NULL).} 73 | 74 | \item{pcaListPredict}{Points to plot within PCA space.} 75 | 76 | \item{pcaPopListPredict}{List of population symbols for plotting additional PCA values.} 77 | 78 | \item{pcaColPredict}{Color for additional PCA values.} 79 | 80 | \item{symbolListPredict}{List with graphical plotting symbols for predict sets (default = NULL).} 81 | 82 | \item{plot}{Whether to plot the PCA analysis (default = FALSE).} 83 | 84 | \item{plotType}{Plot 'points' or sample 'labels' (default = 'points')} 85 | 86 | \item{plotChanges}{Wether to include plots of the changes along the PC axis (default = FALSE).} 87 | 88 | \item{PCx}{PC axis to be presented for x-axis (default PC1).} 89 | 90 | \item{PCy}{PC axis to be presented for y-axis (default PC2).} 91 | 92 | \item{plotCartoon}{Whether to plot a cartoon. This cartoon should be drawn on one of the 93 | samples used in the analysis.} 94 | 95 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 96 | registration analysis) or 'mean' if the images were transformed to a mean shape (only for 97 | meanshape when using landmark transformation)} 98 | 99 | \item{outline}{xy coordinates that define outline.} 100 | 101 | \item{lines}{list of files with xy coordinates of line objects to be added to cartoon.} 102 | 103 | \item{landList}{Landmark landmarkList.} 104 | 105 | \item{adjustCoords}{Adjust landmark coordinates.} 106 | 107 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop 108 | the original image used in landmark or registration analysis.} 109 | 110 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency 111 | between raster and outline coordinates).} 112 | 113 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 114 | 115 | \item{imageList}{List of image should be given if one wants to flip the outline or adjust 116 | landmark coordinates.} 117 | 118 | \item{cartoonID}{ID of the sample for which the cartoon was drawn.} 119 | 120 | \item{refImage}{Image (RasterStack) used for target. Use raster::stack('filename').} 121 | 122 | \item{colpalette}{Vector of colors for color palette 123 | (default = c("white","lightblue","blue","green", "yellow","red"))} 124 | 125 | \item{normalized}{Set this to true in case the summed rasters are already devided by the 126 | sample number.} 127 | 128 | \item{cartoonOrder}{Whether to plot the cartoon outline 'above' or 'under' the pattern raster 129 | (default = 'above'). Set to 'under' for filled outlines.} 130 | 131 | \item{lineOrder}{Whether to plot the cartoon lines 'above' or 'under' the pattern raster 132 | (default = 'above').} 133 | 134 | \item{cartoonCol}{Outline and line color for cartoon (deafault = 'gray').} 135 | 136 | \item{cartoonFill}{Fill color for outline of cartoon (default = NULL).} 137 | 138 | \item{plotLandmarks}{Whether to plot the landmarks from the target image or mean shape 139 | landmarks (default = FALSE).} 140 | 141 | \item{landCol}{Color for plotting landmarks (default = 'black').} 142 | 143 | \item{zlim}{z-axis limit (default = c(0,1))} 144 | 145 | \item{legendTitle}{Title of the raster legend (default = 'Proportion')} 146 | 147 | \item{xlab}{Optional x-axis label.} 148 | 149 | \item{ylab}{Optional y-axis label.} 150 | 151 | \item{main}{Optional main title.} 152 | 153 | \item{...}{additional arguments for PCA plot function.} 154 | } 155 | \value{ 156 | If plot = TRUE: List including a [1] dataframe of the binary raster values that can be used for 157 | principle component analysis, [2] a dataframe of sample IDs and specified population 158 | colors and [3] prcomp results. If plot = FALSE: prcomp result. 159 | } 160 | \description{ 161 | This function transforms the individual color pattern rasters as obtained by the main 162 | patternize functions to a dataframe of 0 and 1 values that can be used for Principal 163 | Component Analysis (\code{\link[stats]{prcomp}}). This function also allows to plot the 164 | analysis including a visualization of the shape changes along the axis. Pixel values 165 | are predicted by multiplying the rotation matrix (eigenvectors) with a vector that has 166 | the same length as the number of rows in the rotation matrix and in which all values are 167 | set to zero except for the PC value for which we want to predict the pixel values. 168 | } 169 | \examples{ 170 | data(rasterList_lanRGB) 171 | 172 | pop1 <- c('BC0077','BC0071') 173 | pop2 <- c('BC0050','BC0049','BC0004') 174 | popList <- list(pop1, pop2) 175 | colList <- c("red", "blue") 176 | 177 | pcaOut <- patPCA(rasterList_lanRGB, popList, colList, plot = TRUE) 178 | 179 | } 180 | \seealso{ 181 | \code{\link[stats]{prcomp}} 182 | } 183 | -------------------------------------------------------------------------------- /man/plotHeat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotHeat.R 3 | \name{plotHeat} 4 | \alias{plotHeat} 5 | \title{Plots the color pattern heatmaps from \code{sumRaster} output.} 6 | \usage{ 7 | plotHeat( 8 | summedRaster, 9 | IDlist, 10 | colpalette = NULL, 11 | plotCartoon = FALSE, 12 | refShape = NULL, 13 | outline = NULL, 14 | lines = NULL, 15 | landList = NULL, 16 | adjustCoords = FALSE, 17 | cartoonID = NULL, 18 | normalized = FALSE, 19 | crop = c(0, 0, 0, 0), 20 | flipRaster = NULL, 21 | flipOutline = NULL, 22 | imageList = NULL, 23 | refImage = NULL, 24 | cartoonOrder = "above", 25 | lineOrder = "above", 26 | cartoonCol = "gray", 27 | cartoonFill = NULL, 28 | plotLandmarks = FALSE, 29 | landCol = "black", 30 | zlim = c(0, 1), 31 | legend = TRUE, 32 | legendTitle = "Proportion", 33 | legend.side = 4, 34 | xlab = "", 35 | ylab = "", 36 | main = "", 37 | plotType = "multi", 38 | imageIDs = NULL, 39 | format = "imageJ" 40 | ) 41 | } 42 | \arguments{ 43 | \item{summedRaster}{Summed raster or summedRasterList.} 44 | 45 | \item{IDlist}{List of sample IDs.} 46 | 47 | \item{colpalette}{Vector of colors for color palette 48 | (default = c("white","lightblue","blue","green", "yellow","red"))} 49 | 50 | \item{plotCartoon}{Whether to plot a cartoon. This cartoon should be drawn on one of the samples 51 | used in the analysis.} 52 | 53 | \item{refShape}{This can be 'target' in case the reference shape is a single sample (for 54 | registration analysis) or 'mean' if the images were transformed to a mean shape (only for 55 | meanshape when using landmark transformation)} 56 | 57 | \item{outline}{xy coordinates that define outline.} 58 | 59 | \item{lines}{list of files with xy coordinates of line objects to be added to cartoon.} 60 | 61 | \item{landList}{Landmark landmarkList.} 62 | 63 | \item{adjustCoords}{Adjust landmark coordinates.} 64 | 65 | \item{cartoonID}{ID of the sample for which the cartoon was drawn.} 66 | 67 | \item{normalized}{Set this to true in case the summed rasters are already devided by the 68 | sample number.} 69 | 70 | \item{crop}{Vector c(xmin, xmax, ymin, ymax) that specifies the pixel coordinates to crop 71 | the original image used in landmark or registration analysis.} 72 | 73 | \item{flipRaster}{Whether to flip raster along xy axis (in case there is an inconsistency 74 | between raster and outline coordinates).} 75 | 76 | \item{flipOutline}{Whether to flip plot along x, y or xy axis.} 77 | 78 | \item{imageList}{List of images should be given if one wants to flip the outline or adjust 79 | landmark coordinates.} 80 | 81 | \item{refImage}{Image (RasterStack) used for target. Use raster::stack('filename').} 82 | 83 | \item{cartoonOrder}{Whether to plot the cartoon outline 'above' or 'under' the pattern raster 84 | (default = 'above'). Set to 'under' for filled outlines.} 85 | 86 | \item{lineOrder}{Whether to plot the cartoon lines 'above' or 'under' the pattern raster 87 | (default = 'above').} 88 | 89 | \item{cartoonCol}{Outline and line color for cartoon (deafault = 'gray').} 90 | 91 | \item{cartoonFill}{Fill color for outline of cartoon (default = NULL).} 92 | 93 | \item{plotLandmarks}{Whether to plot the landmarks from the target image or mean shape 94 | landmarks (default = FALSE).} 95 | 96 | \item{landCol}{Color for ploting landmarks (default = 'black').} 97 | 98 | \item{zlim}{z-axis limit (default = c(0,1))} 99 | 100 | \item{legend}{Whether to plot legend with heatmaps.} 101 | 102 | \item{legendTitle}{Title of the raster legend (default = 'Proportion')} 103 | 104 | \item{legend.side}{Side to plot legend (default = 4)} 105 | 106 | \item{xlab}{Optional x-axis label.} 107 | 108 | \item{ylab}{Optional y-axis label.} 109 | 110 | \item{main}{Optional main title.} 111 | 112 | \item{plotType}{Set as 'PCA' when visualizing shape changes along PCA axis in \ 113 | code{\link[patternize]{patPCA}}, as 'one' when visualizing single image or as 'multi' for multi 114 | plotting or when setting customized margins (default = 'multi').} 115 | 116 | \item{imageIDs}{A list of IDs to match landmarks to images if landmarkList and imageList don't 117 | have the same length.} 118 | 119 | \item{format}{ImageJ (Fiji) or tps format (default = 'imageJ').} 120 | } 121 | \description{ 122 | Plots the color pattern heatmaps from \code{sumRaster} output. 123 | } 124 | \examples{ 125 | data(rasterList_lanRGB) 126 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 127 | outline_BC0077 <- read.table(paste(system.file("extdata", package = 'patternize'), 128 | '/BC0077_outline.txt', sep=''), header = FALSE) 129 | lines_BC0077 <- list.files(path=paste(system.file("extdata", package = 'patternize')), 130 | pattern='vein', full.names = TRUE) 131 | 132 | summedRaster_regRGB <- sumRaster(rasterList_regRGB, IDlist, type = 'RGB') 133 | data(imageList) 134 | 135 | plotHeat(summedRaster_regRGB, IDlist, plotCartoon = TRUE, refShape = 'target', 136 | outline = outline_BC0077, lines = lines_BC0077, crop = c(100,400,40,250), 137 | flipRaster = 'xy', imageList = imageList, cartoonOrder = 'under', cartoonID = 'BC0077', 138 | cartoonFill = 'black', main = 'registration_example') 139 | 140 | \dontrun{ 141 | data(rasterList_lanK) 142 | IDlist <- c('BC0077','BC0071','BC0050','BC0049','BC0004') 143 | summedRasterList <- sumRaster(rasterList_lanK, IDlist, type = 'k') 144 | plotHeat(summedRasterList, IDlist) 145 | 146 | summedRasterList_regK <- sumRaster(rasterList_regK, IDlist, type = 'k') 147 | plotHeat(summedRasterList_regK, IDlist, plotCartoon = TRUE, refShape = 'target', 148 | outline = outline_BC0077, lines = lines_BC0077, crop = c(100,400,40,250), 149 | flipRaster = 'y', imageList = imageList, cartoonOrder = 'under', 150 | cartoonFill = 'black', main = 'kmeans_example') 151 | 152 | plotHeat(summedRasterList_regK[[1]], IDlist, plotCartoon = TRUE, refShape = 'target', 153 | outline = outline_BC0077, lines = lines_BC0077, crop = c(100,400,40,250), 154 | flipRaster = 'y', imageList = imageList, cartoonOrder = 'under', 155 | cartoonFill = 'black', main = 'kmeans_example') 156 | 157 | 158 | prepath <- system.file("extdata", package = 'patternize') 159 | extension <- '_landmarks_LFW.txt' 160 | landmarkList <- makeList(IDlist, 'landmark', prepath, extension) 161 | 162 | summedRaster_lanRGB <- sumRaster(rasterList_lanRGB, IDlist, type = 'RGB') 163 | 164 | plotHeat(summedRaster_lanRGB, IDlist, plotCartoon = TRUE, refShape = 'mean', 165 | outline = outline_BC0077, lines = lines_BC0077, landList = landmarkList, 166 | adjustCoords = TRUE, imageList = imageList, cartoonID = 'BC0077', 167 | cartoonOrder = 'under', cartoonFill= 'black', main = 'Landmark_example') 168 | 169 | summedRaster_lanK <- sumRaster(rasterList_lanK, IDlist, type = 'k') 170 | 171 | plotHeat(summedRaster_lanK, IDlist, plotCartoon = TRUE, refShape = 'mean', 172 | outline = outline_BC0077, lines = lines_BC0077, landList = landmarkList, 173 | adjustCoords = TRUE, imageList = imageList, cartoonID = 'BC0077', 174 | cartoonOrder = 'under', cartoonFill= 'black', main = 'Landmark_example') 175 | 176 | plotHeat(summedRaster_lanK[[2]], IDlist, plotCartoon = TRUE, refShape = 'mean', 177 | outline = outline_BC0077, lines = lines_BC0077, landList = landmarkList, 178 | adjustCoords = TRUE, imageList = imageList, cartoonID = 'BC0077', 179 | cartoonOrder = 'under', cartoonFill= 'black', main = 'Landmark_example') 180 | } 181 | 182 | } 183 | -------------------------------------------------------------------------------- /R/kImageHSV.R: -------------------------------------------------------------------------------- 1 | #' \code{\link[stats]{kmeans}} clustering of image imported as a RasterStack. This function is 2 | #' used by \code{patLanK} and \code{patRegK}. 3 | #' 4 | #' @param image HSV image imported as a RasterStack for k-means clustering. 5 | #' @param k Integer for number of k-means clusters (default = 3). 6 | #' @param startCenter A matrix of cluster centres to start k-means clustering from (default = NULL). 7 | #' @param maskToNA Replace the color value used for masking (i.e. 0 or 255) with NA. 8 | #' @param kmeansOnAll Whether to perform the kmeans clusters on the combined set of pixels of all images 9 | #' first (default = FALSE). 10 | #' @param ignoreHSVvalue Whether to ignore the HSV value (~darkness). 11 | #' 12 | #' @return List including the k-means clustered \code{RasterSatck} returned as an array and object 13 | #' of class "\code{kmeans}". 14 | #' 15 | #' @examples 16 | #' image <- raster::stack(system.file("extdata", "BC0077.jpg", package = "patternize")) 17 | #' out <- kImage(image, 6) 18 | #' 19 | #' @export 20 | #' @import sf 21 | #' @importFrom stats kmeans 22 | #' @importFrom grDevices hsv rgb2hsv 23 | #' @importFrom methods is 24 | 25 | kImageHSV <- function(image, 26 | k = 5, 27 | startCenter = NULL, 28 | maskToNA = NULL, 29 | kmeansOnAll = FALSE, 30 | ignoreHSVvalue = FALSE){ 31 | 32 | if(kmeansOnAll == FALSE){ 33 | 34 | if(is(image)[1] == "RasterStack"){ 35 | image <- raster::as.array(image) 36 | } 37 | 38 | if(ignoreHSVvalue == TRUE){ 39 | df = data.frame( 40 | hue = matrix(image[,,1], ncol=1), 41 | saturation = matrix(image[,,2], ncol=1) 42 | ) 43 | } 44 | else{ 45 | df = data.frame( 46 | hue = matrix(image[,,1], ncol=1), 47 | saturation = matrix(image[,,2], ncol=1), 48 | value = matrix(image[,,3], ncol=1) 49 | ) 50 | } 51 | 52 | if(is.null(startCenter)){ 53 | K = kmeans(na.omit(df),k, nstart = 3) 54 | } 55 | else{ 56 | K = kmeans(na.omit(df),startCenter) 57 | } 58 | df$label <- NA 59 | suppressWarnings(df$label[which(!is.na(df$hue))] <- K$cluster) 60 | 61 | # Replace color of each pixel with mean RGB value of cluster 62 | 63 | # get the coloring 64 | 65 | if(ignoreHSVvalue == TRUE){ 66 | colors = data.frame(label = 1:nrow(K$centers), 67 | H = K$centers[,"hue"], 68 | S = K$centers[,"saturation"]) 69 | } 70 | else{ 71 | colors = data.frame(label = 1:nrow(K$centers), 72 | H = K$centers[,"hue"], 73 | S = K$centers[,"saturation"], 74 | V = K$centers[,"value"]) 75 | } 76 | 77 | # merge color codes on df 78 | 79 | df$order = 1:nrow(df) 80 | df = merge(df, colors, all = TRUE) 81 | df = df[order(df$order),] 82 | df$order = NULL 83 | 84 | # Reshape data frame back into an image 85 | 86 | if(ignoreHSVvalue == TRUE){ 87 | H = matrix(df$H, nrow=dim(image)[1]) 88 | S = matrix(df$S, nrow=dim(image)[1]) 89 | V = matrix(1, nrow=nrow(image), ncol=ncol(image)) 90 | 91 | image.segmented = array(dim=dim(image)) 92 | image.segmented[,,1] = H 93 | image.segmented[,,2] = S 94 | image.segmented[,,3] = V 95 | } 96 | else{ 97 | H = matrix(df$H, nrow=dim(image)[1]) 98 | S = matrix(df$S, nrow=dim(image)[1]) 99 | V = matrix(df$V, nrow=dim(image)[1]) 100 | 101 | image.segmented = array(dim=dim(image)) 102 | image.segmented[,,1] = H 103 | image.segmented[,,2] = S 104 | image.segmented[,,3] = V 105 | } 106 | 107 | out <- list(image.segmented, K) 108 | } 109 | 110 | 111 | if(kmeansOnAll == TRUE){ 112 | 113 | for(n in 1:length(image)){ 114 | 115 | imageX <- image[[n]] 116 | 117 | # convert RGB values to HSV values 118 | imageX <- raster::overlay(imageX, fun = rgb2hsv) 119 | 120 | if(!is.null(maskToNA)){ 121 | imageX[imageX == maskToNA] <- NA 122 | } 123 | 124 | imageX <- raster::as.array(imageX) 125 | 126 | 127 | if(ignoreHSVvalue == TRUE){ 128 | if(n==1){ 129 | dfTot = data.frame( 130 | hue = matrix(imageX[,,1], ncol=1), 131 | saturation = matrix(imageX[,,2], ncol=1) 132 | ) 133 | dfNrowTot <- c(nrow(dfTot)) 134 | } 135 | else{ 136 | df = data.frame( 137 | hue = matrix(imageX[,,1], ncol=1), 138 | saturation = matrix(imageX[,,2], ncol=1) 139 | ) 140 | dfNrow <- c(nrow(df)) 141 | dfNrowTot <- c(dfNrowTot, dfNrow) 142 | 143 | dfTot <- rbind(dfTot, df) 144 | } 145 | } 146 | else{ 147 | if(n==1){ 148 | dfTot = data.frame( 149 | hue = matrix(imageX[,,1], ncol=1), 150 | saturation = matrix(imageX[,,2], ncol=1), 151 | value = matrix(imageX[,,3], ncol=1) 152 | ) 153 | dfNrowTot <- c(nrow(dfTot)) 154 | } 155 | else{ 156 | df = data.frame( 157 | hue = matrix(imageX[,,1], ncol=1), 158 | saturation = matrix(imageX[,,2], ncol=1), 159 | value = matrix(imageX[,,3], ncol=1) 160 | ) 161 | dfNrow <- c(nrow(df)) 162 | dfNrowTot <- c(dfNrowTot, dfNrow) 163 | 164 | dfTot <- rbind(dfTot, df) 165 | } 166 | } 167 | } 168 | 169 | if(is.null(startCenter)){ 170 | K = kmeans(na.omit(dfTot),k, nstart = 3) 171 | } 172 | else{ 173 | K = kmeans(na.omit(dfTot),startCenter) 174 | } 175 | 176 | dfTot$label <- NA 177 | suppressWarnings(dfTot$label[which(!is.na(dfTot$hue))] <- K$cluster) 178 | 179 | # get the coloring 180 | 181 | if(ignoreHSVvalue == TRUE){ 182 | colors = data.frame(label = 1:nrow(K$centers), 183 | H = K$centers[,"hue"], 184 | S = K$centers[,"saturation"]) 185 | } 186 | else{ 187 | colors = data.frame(label = 1:nrow(K$centers), 188 | H = K$centers[,"hue"], 189 | S = K$centers[,"saturation"], 190 | V = K$centers[,"value"]) 191 | } 192 | 193 | # merge color codes on df 194 | 195 | dfTot$order = 1:nrow(dfTot) 196 | dfTot = merge(dfTot, colors, all = TRUE) 197 | dfTot = dfTot[order(dfTot$order),] 198 | dfTot$order = NULL 199 | 200 | 201 | 202 | # Reshape data frame back into an image 203 | s <- 1 204 | e <- 0 205 | image.segmented.list <- list() 206 | 207 | for(n in 1:length(image)){ 208 | 209 | imageX <- image[[n]] 210 | imageX <- raster::as.array(imageX) 211 | 212 | e <- e + dfNrowTot[n] 213 | 214 | df <- dfTot[c(s:e),] 215 | 216 | if(ignoreHSVvalue == TRUE){ 217 | H = matrix(df$H, nrow=dim(imageX)[1]) 218 | S = matrix(df$S, nrow=dim(imageX)[1]) 219 | V = matrix(1, nrow=nrow(imageX), ncol=ncol(imageX)) 220 | 221 | image.segmented = array(dim=dim(imageX)) 222 | image.segmented[,,1] = H 223 | image.segmented[,,2] = S 224 | image.segmented[,,3] = V 225 | } 226 | else{ 227 | H = matrix(df$H, nrow=dim(imageX)[1]) 228 | S = matrix(df$S, nrow=dim(imageX)[1]) 229 | V = matrix(df$V, nrow=dim(imageX)[1]) 230 | 231 | image.segmented = array(dim=dim(imageX)) 232 | image.segmented[,,1] = H 233 | image.segmented[,,2] = S 234 | image.segmented[,,3] = V 235 | } 236 | 237 | image.segmented.list[[names(image)[n]]] <- image.segmented 238 | 239 | s <- s + dfNrowTot[n] 240 | } 241 | out <- list(image.segmented.list, K) 242 | } 243 | 244 | return(out) 245 | } 246 | --------------------------------------------------------------------------------