how to multiply three arrays with different dimension in PyTorch - pytorch

enter image description here
L array dimension is (d,a) ,B is (a,a,N) and R is (a,d). By multiplying these arrays I have to get an array size of (d,d,N). How could I implement this is PyTorch

A possible and straightforward approach is to apply torch.einsum (read more here):
>>> torch.einsum('ij,jkn,kl->iln', L, B, R)
Where j and k are the reduced dimensions of L and R respectively. And n is the "batch" dimension of B.
The first matrix multiplication will reduce L#B (let this intermediate result be o):
ij,jkn->ikn
The second matrix multiplication will reduce o#R:
ikn,kl->iln
Which overall sums up to the following form:
ij,jkn,kl->iln

It seems like doing batch matrix multiplication. Like result[:,:, i]=L#B[:,:,i]#R. You can use:
B = B.permute([2,0,1])
result = torch.matmul(torch.matmul(L, B), R).permute([1,2,0])

N seems to be the batch dimension, let's forget it first.
It is simple chained matrix multiplication:
d, a = 3, 5
L = torch.randn(d, a)
B = torch.randn(a, a)
R = torch.randn(a, d)
L.matmul(B).shape # (d, a)
L.matmul(B).matmul(R).shape # (d, d)
Now let's add the batch dimension N.
Everything is almost the same, but PyTorch works with batch dim first whereas your data is batch dim last, so a bit of movedim is required.
N = 7
B = torch.randn(a, a, N)
L.matmul(B.movedim(-1, 0)).shape # (N, d, a)
L.matmul(B.movedim(-1, 0)).matmul(R).shape # (N, d, d)
L.matmul(B.movedim(-1, 0)).matmul(R).movedim(0, -1).shape # (d, d, N)

Related

Find all non co-linear points

Given a set of points in the 2-D Plane, is it possible to find a set of all possible non co-linear points in the 2-D plane?
Time Complexity doesn't matter at present just that the solution be correct.
What you're asking for might need clarification. Any two points are collinear to each other, since a line connects them. To make this question answerable, it seems I must interpret what you're asking to mean this: that if any number of points greater than or equal to three are all collinear with each other, our set of non-collinear points can contain only one of the collinear points.
Given this, we can do the following:
for each pair of points, calculate the slope between them as (y - y') / (x - x'). If x = x', simply note that slope as V.
next, for each pair of points and slope, check all the other pairs of points involving either of the points in the pair and see whether the corresponding slope is the same as the one being checked. Take all the points so determined and add them to a collection and add this collection to a collection.
Once you have finished, you will have a collection of collections, and all the points in each collection in your collection will consist of points which are all collinear to each other.
Now the problem is the following: Find the largest number of points that can be chosen so that no two points exist in two of the collections. If you picked two points that were in one of the collections, you'd have picked two points that were collinear together with at least one other point.
At this point, we can simply try all 2^n subsets of n points and check each one to see if it is acceptable (in that the intersection of the subset and any collection has size at most one).
Example:
p = (1, 1), q = (2, 2), r = (3, 3), s = (2, 3)
m = [ - 1 1 2]
[ 1 - 1 V]
[ 1 1 - 0]
[ 2 V 0 -]
(p, q): r yes, s no; collection (p, q, r)
(p, r): q yes, s no; collection (p, q, r)
(p, s): q no, r no; no collection
(q, p): r yes, s no; collection (p, q, r)
(q, r): p yes, s no; collection (p, q, r)
(q, s): p no, r no; no collection
(r, p): q yes, s no; collection (p, q, r)
(r, q): p yes, s no; collection (p, q, r)
(r, s): p no, q no; no collection
(s, p): q no, r no; no collection
(s, q): p no, r no; no collection
(s, r): p no, q no; no collection
Try candidate (p, q, r, s): intersection with (p, q, r) has size > 1, reject
Try candidate (p, q, r): intersection with (p, q, r) has size > 1, reject
Try candidate (p, q, s): intersection with (p, q, r) has size > 1, reject
…
Try candidate (p, s): intersection with (p, q, r) has size = 1, accept
This is clearly exponential in time and space but this will solve the problem.

Matrix multiplication of row-major recursively

I'm programming my own matrix module for fun and practice (Time and space complexity does not matter).
Now I want to implement matrix multiplication and I am struggling with it. It probably the reason I am using Haskell and I haven't had much experience with it.
This is my data type:
data Matrix a =
M {
rows::Int,
cols::Int,
values::[a]
}
Which stores a 3x2 Matrix like this in array:
1 2
3 4
5 6
= [1,2,3,4,5,6]
I have a somewhat working transpose function
transpose::(Matrix a)->(Matrix a)
transpose (M rows cols values) = M cols rows (aux values 0 0 [])
where
aux::[a]->Int->Int->[a]->[a]
aux values row col transposed
| cols > col =
if rows > row then
aux values (row+1) col (transposed ++ [valueAtIndex (M rows cols values) (row,col)])
else aux values 0 (col+1) transposed
| otherwise = transposed
To index the elements in the array I am using this function
valueAtIndex::(Matrix a)->(Int, Int)->a
valueAtIndex (M rows cols values) (row, col)
| rows <= row || cols <= col = error "indices too large for given Matrix"
| otherwise = values !! (cols * row + col)
From my understanding, I have to get elements like this for m1: 2x3 and m2: 3x2
m1(0,0)*m2(0,0)+m1(0,1)*m2(0,1)+m1(0,2)*m2(0,2)
m1(0,0)*m2(1,0)+m1(0,1)*m2(1,1)+m1(0,2)*m2(1,2)
m1(1,0)*m2(0,0)+m1(1,1)*m2(0,1)+m1(1,2)*m2(0,2)
m1(1,0)*m2(1,0)+m1(1,1)*m2(1,1)+m1(1,2)*m2(2,2)
Now I need a function that takes two matrices, with rows m1 == cols m2 and then somehow recursively calculate the correct matrix.
multiplyMatrix::Num a=>(Matrix a)->(Matrix a)->(Matrix a)
First of all, I'm not really convinced that such linear list is a good idea. A list in Haskell is modelled as a linked list. So that means that typically accessing the k-th element, will run in O(k). So for an m×n-matrix that means it takes O(m n) in order to access the last element. By using a 2d linked list: a linked list that contains linked lists, we scale that down to O(m+n), which is typically faster. Yes there is some overhead since you use more "cons" data constructors, but the amount of traversing is typically lower. In case you really want fast access, you should use arrays, vectors, etc. But then there are other design decisions to make.
So I propose we model the matrix as:
data Matrix a = M {
rows :: Int,
cols :: Int,
values :: [[a]]
}
Now with this data constructor we can define a transpose as:
transpose' :: Matrix a -> Matrix a
transpose' (M r c as) = M c r (trans as)
where trans [] = []
trans xs = map head xs : trans (map tail xs)
(here we assume that the list of lists is always rectangular)
So now for the matrix multiplication. If A and B are two matrices, and C = A × B, then that basically means that ai, j is the dot product of the i-th row of A, and the j-th column of B. Or the i-th row of A, and the j-th row of BT (the transpose of B). We can thus define the dot product as:
dot_prod :: Num a => [a] -> [a] -> a
dot_prod xs ys = sum (zipWith (*) xs ys)
and now it is only a matter of iterating through the rows and columns, and placing the elements in the right list. Like:
mat_mul :: Num a => Matrix a -> Matrix a -> Matrix a
mat_mul (M r ca xss) m2 | ca /= ra = error "Invalid matrix shapes"
| otherwise = M r c (matmul xss)
where (M c rb yss) = transpose m2
matmul [] = []
matmul (xs:xss) = generaterow yss xs : matmul xss
generaterow [] _ = []
generaterow (ys:yss) xs = dot_prod xs ys : generaterow yss xs

Trapezoid Rule in Haskell

I'm trying to define the trapezoid rule in Haskell. I created a helper function innerSum, which is sum portion of the trapezoid rule. Then in the integral definition I multiple by the distance and take in the lower bound, upper bound, a function, and some n number of trapezoids.As n increases the answer should become more accurate. My function seems to work for most cases
except this case (and likely others):
definiteIntegral (-1) 1 (\x->x^100) 20.
As I change the value for 20 instead of my answers diverging to a certain and getting more accurate, the numbers just jump randomly. I cannot seem to find the mistake
definiteIntegral :: Double -> Double -> (Double -> Double) -> Integer -> Double
definiteIntegral a b g n | a <= b = (dist a b n)*(innerSum a b g (dist a b n))
| otherwise = (dist a b n)*(innerSum b a g (dist b a n))
where dist a b n = (b-a)/(fromIntegral n::Double)
innerSum :: Double -> Double -> (Double -> Double) -> Double -> Double
innerSum a b g d | a >= b = 0
| otherwise = (((g a) + (g (a + d)))/2)+(innerSum (a + d) b g d)
The problem is your end condition. You calculate the step size so in principle, you should end up exactly at the right boundary after n steps. And indeed that will work if you make sure the step size can be exactly represented in floating-point, i.e. a multiple of a power of two:
*Main> definiteIntegral (-1) 1 (^100) <$> [64, 128, 256, 512, 1024]
[3.396429282002939e-2,2.3718601030590182e-2,2.08093271780123e-2,2.0055667986086628e-2,1.9865519301509465e-2]
-- convergence towards 1.98×10⁻²
But most numbers can not be exactly represented in FP, therefore you'll regularly not hit the right boundary exactly. If the last point falls slightly short of that bound, the algorithm will do an entire extra step, i.e. you blow up a small float inaccuracy to an entire-step inaccuracy. Numerically speaking, it's “just” an order-1 error, because that single step size gets ever smaller as you increase the resolution. (It's still bad, because the trapezoidal rule should actually be second-order accurate!)
Problem with (^100) in particular is: that function is very close to zero on most of the interval [-1,1], but grows very quickly in the vicinity of &pm;1. Therefore the result of the interval is dominated by the trapezes right next to the boundary, and even more by a trapeze outside the boundary!
The easiest fix is to get rid of that innerSum function and use built-in tools instead:
definiteIntegral :: Double -> Double -> (Double -> Double) -> Integer -> Double
definiteIntegral a b g n
| a <= b = - definiteIntegral b a g n
| otherwise = δ * sum [ (g x + g (x+δ))/2
| x <- [a, a+δ .. b] ]
where δ = (b-a) / fromIntegral n
It is explained in this question why that works reliable even when the step size is not exactly represented: float ranges like [a, a+δ .. b] refuse to take an extra step if the previous one is already close to the boundary and the next one would take you far beyond the boundary.

How can I produce a fixed length of numbers that sum up a given number in Haskell

I'm new to haskell world and wanted to know, given any positive integer and number of digits between 1-9 how can I find the combination of numbers that sum into the positive integer using the provided number of digits in Haskell. For example,
4 using two digits can be represented as a list of [[2,2],[3,1]] using three digits as a list of [[1,1,2]],
5 using two digits can be represented as a list of [[2,3],[4,1]] using three digits as a list of [[1,1,3],[2,2,1]]
Assuming that you want to avoid a brute-force approach, this can be regarded as a typical dynamic-programming problem:
import Data.Array
partitions :: Int -> Int -> [[Int]]
partitions m n = table ! (m, n, 9)
where
table = listArray ((1, 1, 1), (m, n, 9)) l
l = [f i j k | i <- [1 .. m], j <- [1 .. n], k <- [1 .. 9]]
f i 1 k = if i > k `min` 9 then [] else [[i]]
f i j k = [d : ds | d <- [1 .. k `min` pred i], ds <- table ! (i - d, j - 1, d)]
The idea is to construct a three-dimensional lazy array table in which a cell with index (i, j, k) contains all partitions ds of the positive integer i into lists of j digits drawn from [1 .. k] such that sum ds == i.
For example:
> partitions 4 2
[[2,2],[3,1]]
> partitions 4 3
[[2,1,1]]
> partitions 5 2
[[3,2],[4,1]]
> partitions 5 3
[[2,2,1],[3,1,1]]
If you really don't want to think about the problem, and you really should because dynamic programming is good brain food, then you can ask the computer to be smart on your behalf. For example, you could use a tool called an SMT solver to which the sbv package gives you easy access.
Encoding Partitioning in SBV
A great advantage of solvers is you merely need to express the problem and not the solution. In this case lets declare some number of integers (identified by len) which are values 1..9 that sum to a known result (sumVal):
intPartitions :: Int -> Int -> IO AllSatResult
intPartitions sumVal len = allSat $ do
xs <- mapM exists [show i | i <- [1..len]] :: Symbolic [SWord32]
mapM (constrain . (.< 10)) xs
mapM (constrain . (.> 0)) xs
return $ sum xs .== fromIntegral sumVal
Calling this function is rather simple we just have to import the right libraries and print out what are called the satisfying "models" for our problem:
import Data.SBV
import Data.List (nub,sort)
main = do
res <- intPartitions 5 3
print (nub (map sort (extractModels res :: [[Word32]])))
Notice I sorted and eliminated duplicate solutions because you didn't seem to care that [1,1,3], [3,1,1] etc were all solutions - you just want one permutation of the resulting assignments.
For these hard-coded values we have a result of:
[[1,1,3],[1,2,2]]
Well a simple brute force does the trick:
import Data.List
import Control.Monad
sums :: Int -> Int -> [[Int]]
sums number count = nub . map sort . filter ((==number) . sum) $ replicateM count [1..number+1-count]
Note that this is very inefficient. The usage of nub . map sort only shortens the result by removing doubled elements.
This is usually solved by using dynamic programming to avoid recomputing common sub-problems. But this is not the most important problem here: you need to start by coming up with the recursive algorithm! You will have plenty of time to think about producing an efficient solution once you've solved that problem. Hence this answer in two steps. The whole gist without comments is available here.
I start off by giving names to types because I'd get confused with all the Ints floating around and I consider types to be documentation. You might be more clever than I am and not need all this extra stuff.
type Target = Int
type Digits = Int
type MaxInt = Int
Now, the bruteforce solution: We're given the number of Digits left to partition a number, the Target number and the MaxInt we may use in this partition.
partitionMaxBrute :: Digits -> Target -> MaxInt -> [[Int]]
partitionMaxBrute d t m
If we have no digits left and the target is zero, we're happy!
| d == 0 && t == 0 = [[]]
If the product of Digits by MaxInt is smaller than Target or if the MaxInt itself is smaller than zero, there is no way we may succeed accumulating Digits non-zero numbers! :(
| d * m < t || m <= 0 = []
If MaxInt is bigger than our Target then we better decrease MaxInt if we want to have a solution. It does not make sense to decrease it to anything bigger than Target + 1 - Digits.
| t < m = partitionMaxBrute d t (t + 1 - d)
Finally, we may either lower MaxInt (we are not using that number) or substract MaxInt from Target and keep going (we are using MaxInt at least once):
| otherwise = partitionMaxBrute d t (m - 1)
++ fmap (m :) (partitionMaxBrute (d - 1) (t - m) m)
Given that solution, we can get our brute force partition: it's the one where the MaxInt we start with is Target + 1 - Digits which makes sense given that we are expecting a list of Digits non-zero numbers.
partitionBrute :: Digits -> Target -> [[Int]]
partitionBrute d t = partitionMaxBrute d t (t + 1 - d)
Now comes the time of memoization: dynamic programming is taking advantage of the fact that the smaller problems we solve are discovered through a lot of different paths and we do not need to recompute the answer over and over again. Easy caching is made possible by the memoize package. We simply write the same function with its recursive calls abstracted:
partitionMax :: (Digits -> Target -> MaxInt -> [[Int]]) ->
Digits -> Target -> MaxInt -> [[Int]]
partitionMax rec d t m
| d == 0 && t == 0 = [[]]
| d * m < t || m <= 0 = []
| t < m = rec d t (t + 1 - d)
| otherwise = rec d t (m - 1)
++ fmap (m :) (rec (d - 1) (t - m) m)
And make sure that we cache the values:
partition :: Digits -> Target -> [[Int]]
partition d t = memoPM d t (t + 1 - d)
where memoPM = memoize3 $ partitionMax memoPM
You can produce all partitions directly:
type Count = Int
type Max = Int
type Target = Int
partitions :: Count -> Max -> Target -> [[Int]]
partitions 0 m 0 = [[]]
partitions k m n = do
let m' = min m (n - k + 1)
d <- takeWhile (\d -> n <= k * d) [m', m' - 1 .. 1]
map (d:) $ partitions (k - 1) d (n - d)
It's easy to check, that there are no redundant cases. We just need to replace do with redundant $ do, where redundant is
redundant [] = [[]]
redundant xs = xs
If partitions (k - 1) d (n - d) returned [], then redundant would make [[]] from it, and then map (d:) $ partitions (k - 1) d (n - d) would be equal to [d]. But output doesn't change with the redundant function, so all partitions are generated directly.
The code is pretty simple and fast, since you want to produce partitions, rather than count them.

Calculate an image histogram with repa

I'm loading an RGB image from disk with JuicyPixels-repa. Unfortunately the Array representation of the image is Array F DIM3 Word8 where the inner dimension is the RGB pixels. That's a bit incompatibe with existing repa imageprocessing algorithms where an RGB image is Array U DIM2 (Word8, Word8, Word8).
I want to calculate the RGB histograms of the image, I'm searching a function with the Signature:
type Hist = Array U DIM1 Int
histogram:: Array F DIM3 Word8 -> (Hist, Hist, Hist)
how can I fold my 3d array to get a 1d array for each colorchannel?
Edit:
The main problem is not that I'm not able to convert from DIM3 to DIM2 for each channel (easy done with slicing). The problem is that I have to iterate the source image DIM2 or DIM3 and have to accumulate to an DIM1 array of a different Shape (Z:.256) and extent.
So I can't use repa's foldS as it reduces the dimension by one, but with the same extent.
I also experimented with traverse but it iterates over the extent of the destination image, providing a function to get pixels from the source image, that would lead to very inefficient code, counting the same pixels for each colorvalue.
A good way would be a simple folding over a Vector with the histogram type as accumulator, but unfortunately I have no U (unboxed) or V (vector) based array, from which I can efficiently get a Vector. I have an Array F (foreign pointer).
Ok, I found a few minutes. Below, I cover four solutions and have made the worst solutions (the middle two, involving O(n) data conversion) really easy for you.
Lets Acknowledge the Dumb Solution
It's reasonable to start with the obvious. You could use Data.List.foldl to traverse the rows and columns, building up your histograms from initial zero arrays (untested/partial code follows):
foldl (\(histR, histG, histB) (row,col) ->
let r = arr ! (Z:.row:.col:.0)
g = arr ! (Z:.row:.col:.1)
b = arr ! (Z:.row:.col:.2)
in (incElem r histR, incElem g histG, incElem b histB)
(zero,zero,zero)
[ (row,col) | row <- [0..nrRow-1], col <- [0..nrCol-1] ]
...
where (Z:.nrRow:.nrCol:._) = extent arr
I'm not sure how efficient this will be, but suspect that it will do too much bounds checking. Switching to unsafeIndex should do reasonably, assuming the delayed arrays, hist*, do well due to however you'd pick to implement incElem.
You Can Build the Array You Want
Using traverse you can actually convert JP-Repa style arrays into DIM2 arrays with tuples for elements:
main = do
let arr = R.fromFunction (Z:.a:.b:.c) (\(Z:.i:.j:.k) -> i+j-k)
a =4 :: Int
b = 4 :: Int
c= 4 :: Int
new = R.traverse arr
(\(Z:.r:.c:._) -> Z:.r:.c) -- the extent
(\l idx -> (l (idx:.0)
,l (idx:.1)
,l (idx :. 2)))
print (R.computeS new :: R.Array R.U DIM2 (Int,Int,Int))
Could you point me to the body of code you talked about that uses this format? It would be simple to patch JP-Repa to include a function of this type.
You can build the Unboxed Vector You Mentioned
You mentioned an easy solution is to fold over unboxed vectors, but lamented that JP-repa doesn't provide an unboxed array. Luckily, conversion is simple:
toUnboxed :: Img a -> VU.Vector Word8
toUnboxed = R.toUnboxed . R.computeUnboxedS . R.delay . imgData
We Could Patch Repa
This is really only a problem because Repa doesn't have what I consider a normal traverse function. Repa's traverse is more of an array construction that happens to provide an indexing function into another array. We want traverse in the form:
newTraverse :: Array r sh e -> a -> (a -> sh -> e -> a) -> a
but of coarse this is actually just a malformed fold. So lets rename it and reorder the arguments:
foldAllIdxS :: (sh -> a - > e -> a) -> a -> Array r sh e -> a
which contrasts nicely with the (preexisting) foldAllS operation:
foldAllS :: (a -> a -> a) -> a -> Array r sh a -> a
Notice how our new fold has two critical characteristics. The result type is not required to match the element type, so we could start with a tuple of Histograms. Second, our version of fold passes the index, which allows you to select which histogram in the tuple to update (if any).
You can lazily use the latest JuicyPixels-Repa
To acquire your preferred Repa array format, or to acquire an unboxed vector, you can just use the newly uploaded JuicyPixels-Repa-0.6.
someImg <- readImage path :: IO (Either String (Img RGBA))
let img = either (error "Blah") id someImg
uvec = toUnboxed img
tupleArr = collapseColorChannel img
Now you can fold over the vector or use the tuple array directly, as you originally desired.
I also took an ugly stab at fleshing out the first, horribly naive, solution:
histograms :: Img a -> (Histogram, Histogram, Histogram, Histogram)
histograms (Img arr) =
let (Z:.nrRow:.nrCol:._) = R.extent arr
zero = R.fromFunction (Z:.256) (\_ -> 0 :: Word8)
incElem idx x = RU.unsafeTraverse x id (\l i -> l i + if i==(Z:.fromIntegral idx) then 1 else 0)
in Prelude.foldl (\(hR, hG, hB, hA) (row,col) ->
let r = R.unsafeIndex arr (Z:.row:.col:.0)
g = R.unsafeIndex arr (Z:.row:.col:.1)
b = R.unsafeIndex arr (Z:.row:.col:.2)
a = R.unsafeIndex arr (Z:.row:.col:.3)
in (incElem r hR, incElem g hG, incElem b hB, incElem a hA))
(zero,zero,zero,zero)
[ (row,col) | row <- [0..nrRow-1], col <- [0..nrCol-1] ]
I'm too wary of the performance of this code (3 traversals per index... I must be tired) to throw it into JP-Repa, but if you find it works well then let me know.

Resources