error FOR2614: assignment between arrays of differing rank - multidimensional-array

Hello guys I'm new at learn studying Fortran, but i need a help cause i got error
FOR2614: assignment between arrays of differing rank
when compiling my program. I'll left screenshot about what i write, i hope any of you can help me thanks.
REAL,INTENT(OUT)::BKL1(2,2),BKL2(2,2),BKL3(2,2),BKL4(2,2)
REAL,INTENT(OUT)::DX(2)
REAL,DIMENSION(2)::DX1,DX2,DX3,DX4
DX1(1) = 0
DX1(2) = DX(1)
DX2(1) = DX(1)
DX2(2) = DX(2)
DX3(1) = DX(2)
DX3(2) = DX(3)
DX4(1) = DX(3)
DX4(2) = 0
FT1 = MATMUL(BKL1,DX1)
FT2 = MATMUL(BKL2,DX2)
FT3 = MATMUL(BKL3,DX3)
FT4 = MATMUL(BKL4,DX4)
WRITE(*,*)'GAYA DALAM BATANG 1'
WRITE(*,*) FT1
WRITE(*,*)'GAYA DALAM BATANG 2'
WRITE(*,*) FT2
WRITE(*,*)'GAYA DALAM BATANG 3'
WRITE(*,*) FT3
WRITE(*,*)'GAYA DALAM BATANG 4'
WRITE(*,*) FT4
RETURN
END

assignment between arrays of differing rank
You forgot to DIMENSION(2)::FT1,FT2,FT3,FT4.

Related

Julia UndefVarError on Metaprogramming

I'm trying to do a solver for equations. When I run the code the X variable appears to be undefined, but it prints out perfectly. What am I missing?
I should give the program some numbers, than operations as Macros and it should create an outer product matrix of the operations applied.
function msu()
print("Insert how many values: ")
quantity = parse(Int64, readline())
values = []
for i in 1:quantity
println("x$i")
num1 = parse(Float64, readline())
push!(values, num1)
end
println(values)
print("How many operations? ")
quantity = parse(Int64, readline())
ops = []
for i in 1:quantity
push!(ops, Meta.parse(readline()))
end
mat = zeros((quantity, quantity))
for i in 1:length(mat)
sum = 0
for j in 1:length(values)
# here begins problems, the following prints are for debugging purpose
print(length(values))
func = Meta.parse("$(ops[convert(Int64, ceil(j / quantity))]) * $(ops[convert(Int64, j % quantity)])")
print(func)
x = values[j]
println(x)
sum += eval(func)
end
mat[i] = sum
end
println(mat)
end
msu()
The original code was in Spanish, if you find any typo it's probably because I skipped a translation.

Writing a clean/cleaner solution to "Valid Anagram" in Elixir

Trying to level up my Elixir understanding by doing algo/leetCode style problems using Elixir.
As I'm a relatively new programmer (around a year in) and was trained on traditionally OOP languages like Ruby and JS, it's still somewhat hard for me to wrap my head around doing algo questions in a functional paradigm, though I felt I understood the Udemy course I took on Elixir/Phoenix.
I wrote a solution to the LeetCode "valid anagram" problem using Elixir and Repl and wanted to see if people had any ideas for improving/understanding the problem or if there was a best approach way of thinking for this problem.
For an answer, I'd take a code review, a book recommendation or even just suggestions of what I could do differently.
Thank you for your time and hope this (my first question on this site) is clear.
###
Given two strings s and t , write a function to determine if t is an anagram of s.
Example 1:
Input: s = "anagram", t = "nagaram"
Output: true
Example 2:
Input: s = "rat", t = "car"
Output: false
Note:
You may assume the string contains only lowercase alphabets.
###
defmodule Algos do
def is_anagram(str1, str2) do
case String.length(str1) == String.length(str2) do
false ->
IO.puts(false)
true ->
both_trackers(str1, str2)
|> check_trackers
|> IO.puts
end
end
def both_trackers(str1, str2) do
t1 = make_tracker(str1)
t2 = make_tracker(str2)
{t1, t2}
end
def check_trackers({t1, t2}) do
Map.keys(t1)
|> Enum.reduce_while(true, fn x, acc ->
if t1[x] == t2[x], do: {:cont, acc}, else: {:halt, false}
end)
end
def make_tracker(str) do
tracker = String.split(str, "", trim: true)
|> Enum.reduce(%{},
fn x,acc -> Map.merge(acc,
case !!acc[x] do
false ->
%{x => 1}
true ->
%{x => acc[x] + 1}
end
)
end
)
tracker
end
end
Algos.is_anagram("sloop ", "pools")
New elixir has Enum.frequencies, which generates a histogram from an enumerable, which basically solves this problem out of the box:
defmodule Algos do
def anagram?(a, b) do
Enum.frequencies(to_charlist(a)) == Enum.frequencies(to_charlist(b))
end
end
Algos.anagram?("a gentleman", "elegant man") # => true
Algos.anagram?("alice", "bob") # => false

julia double for loops, looping over dictionaries

I have just started using Julia. To my understanding Julia allows you to declare multiple for loops on a single line.
For example, this:
for i = 1:2, j = [-1,-2]
println((i, j))
end
Will result in this:
(1,-1)
(1,-2)
(2,-1)
(2,-2)
I am now doing something similar but while looping over dictionaries. I declare the following:
rename = function(x)
x["num"] = -x["num"]
x
end
players1 = [["num" => 1],["num" => 2]]
players2 = map(rename, copy(players1)) # = [["num" => -1],["num" => -2]]
Oddly, to me, when I do this:
for i=players1, j=players2
println(i, j)
end
Why don't I get this output?
["num"=>1]["num"=>-1]
["num"=>1]["num"=>-2]
["num"=>2]["num"=>-1]
["num"=>2]["num"=>-2]
Ah. The map functions still needs a deepcopy in this case.
This snippet of code does seem to work.
rename = function(x)
x["num"] = -x["num"]
x
end
players1 = [["num" => 1],["num" => 2]]
players2 = map(rename, deepcopy(players1))
for i=players1, j=players2
println(i, j)
end

fortran 90 expected bounds specification during pointer assignment

I am new to Fortran. I am writing a program in Fortran 90 to get non-zero elements of an array and put them into a new array using pointer function as following:
program prog
implicit none
integer, target :: a(5)
integer :: i
integer, pointer :: nz(:)
a(1) = 1
a(2) = 0
a(3) = 0
a(4) = 2
a(5) = 3
nz => non_zeros(a)
do i=1, size(nz)
write(*,*) nz(i)
end do
contains
function non_zeros(a)
integer, target :: a(:)
integer, pointer:: non_zeros(:)
integer :: n, i, j
n = count(a .ne. 0)
allocate(non_zeros(n))
j = 0
do i=1, m
if (a(i) .ne. 0) then
j = j + 1
non_zeros(j) => a(i)
end if
end do
end function non_zeros
end program prog
during compiling I got the error:
non_zeros(j) => a(i)
1
Error: Expected bounds specification for 'non_zeros' at (1)
Can you please tell me what did I do wrong? Thank you in advance!
Update of my question: According to the explanation of High Performance Mark, I defined a derived type:
program prog
implicit none
integer, target :: a(5)
type dt
integer, pointer :: x
end type
type(dt), allocatable :: nz(:)
a(1) = 1
a(2) = 0
a(3) = 0
a(4) = 2
a(5) = 3
nz = non_zeros(a)
contains
function non_zeros(a)
integer, target :: a(:)
type(dt), allocatable :: non_zeros(:)
integer :: n, i, j
n = count(a .ne. 0)
allocate(non_zeros(n))
j = 0
do i=1, m
if (a(i) .ne. 0) then
j = j + 1
non_zeros(j)%x => a(i)
end if
end do
end function non_zeros
end program prog
Now program works and gives the desired results. However, I did not use pointer function in this case, since my function returns an allocatable array of pointers, not pointer to an array. Is there any way to use pointer function here? Thank you
To get the non-zero elements of a into a new array you could simply declare
integer, dimension(:), allocatable :: non_zeros
and then populate that with the statement
non_zeros = pack(a,a/=0)
and avoid fiddling around with pointers entirely. This relies on a feature introduced in the 2003 standard, but it is implemented by all (I think) the current crop of Fortran compilers on the market.
The code that you have written looks to me as if you want nz to be an array of pointers, with each element in nz pointing to a non-zero element of a. If I'm right, you've misunderstood what a statement such as
integer, pointer :: nz(:)
declares. It does not declare an array of pointers to integers, it declares a pointer to an array of integers. When you write
non_zeros(j) => a(i)
you're making the mistake of trying to set an element of non_zeros to point to an element of a.
The error message is misleading here because the compiler interprets non_zeros(j) as a syntactically-incorrect bounds-spec or bounds-remapping, but the error is semantic, the compiler doesn't understand your misunderstanding of Fortran.

Permutation of jagged array

I'm trying to create a permutation of a multidimensional array in classic asp (vbscript) and I'm seriously stuck. I've tried several functions of my own and also tried copying several php versions over, but I often end up with something that either goes into a buffer overflow / infinite recursion or I get results that are more like a combination than a permutation, if I understand the differences correctly.
Lets say it's for a shirt. The shirt can have colors, sizes, and styles. (The actual system allows for any number of "groups" of options (think color, size, etc) and also any number of options within each group (each particular size, each particular color,etc).
For example:
small med lg xl
red blue green white
pocket no-pocket
Note that the number of elements in either dimension of the array are unknown beforehand; also, not all second dimensions will have the same number of elements.
I need to iterate through each possible unique option that contains an option from each row. In this particular example, there would be 32 options (because I need to ignore results that have an empty value for any given option, since asp doesn't really handle a jagged array the way I would expect. So:
small red pocket
small red no-pocket
small blue pocket
small blue no-pocket
etc.
Once I have this part done, I'll need to integrate it with some IDs from the database, but I'm fairly sure I can do that part on my own. It's the recursive function that's killing me.
Anyone able to point me in a good starting place or help me out? Any help is MUCH appreciated!
To avoid problems of terminology: I wrote a small program:
Dim aaItems : aaItems = Array( _
Array( "small", "med", "lg", "xl" ) _
, Array( "red", "blue", "green", "white" ) _
, Array( "pocket", "no-pocket" ) _
)
Dim oOdoDemo : Set oOdoDemo = New cOdoDemo.init( aaItems )
oOdoDemo.run 33
and that's its output:
0: small red pocket
1: small red no-pocket
2: small blue pocket
3: small blue no-pocket
4: small green pocket
5: small green no-pocket
6: small white pocket
7: small white no-pocket
8: med red pocket
9: med red no-pocket
10: med blue pocket
11: med blue no-pocket
12: med green pocket
13: med green no-pocket
14: med white pocket
15: med white no-pocket
16: lg red pocket
17: lg red no-pocket
18: lg blue pocket
19: lg blue no-pocket
20: lg green pocket
21: lg green no-pocket
22: lg white pocket
23: lg white no-pocket
24: xl red pocket
25: xl red no-pocket
26: xl blue pocket
27: xl blue no-pocket
28: xl green pocket
29: xl green no-pocket
30: xl white pocket
31: xl white no-pocket
32: small red pocket
If that looks like a seed to a solution of your problem, just say so and I will post the code for the cOdoDemo class.
Code for cOdoDemo:
'' cOdoDemo - Q&D combinations generator (odometer approach)
'
' based on ideas from:
' !! http://www.quickperm.org/index.php
' !! http://www.ghettocode.net/perl/Buzzword_Generator
' !! http://www.dreamincode.net/forums/topic/107837-vb6-combinatorics-lottery-problem/
' !! http://stackoverflow.com/questions/127704/algorithm-to-return-all-combinations-of-k-elements-from-n
Class cOdoDemo
Private m_nPlaces ' # of places/slots/digits/indices
Private m_nPlacesUB ' UBound (for VBScript only)
Private m_aLasts ' last index for each place => carry on
Private m_aDigits ' the digits/indices to spin around
Private m_aaItems ' init: AoA containing the elements to spin
Private m_aWords ' one result: array of combined
Private m_nPos ' current increment position
'' init( aaItems ) - use AoA of 'words' in positions to init the
'' odometer
Public Function init( aaItems )
Set init = Me
m_aaItems = aaItems
m_nPlacesUB = UBound( m_aaItems )
m_nPlaces = m_nPlacesUB + 1
ReDim m_aLasts( m_nPlacesUB )
ReDim m_aDigits( m_nPlacesUB )
ReDim m_aWords( m_nPlacesUB )
Dim nRow
For nRow = 0 To m_nPlacesUB
Dim nCol
For nCol = 0 To UBound( m_aaItems( nRow ) )
m_aaItems( nRow )( nCol ) = m_aaItems( nRow )( nCol )
Next
m_aLasts( nRow ) = nCol - 1
Next
reset
End Function ' init
'' reset() - start afresh: all indices/digit set to 0 (=> first word), next
'' increment at utmost right
Public Sub reset()
For m_nPos = 0 To m_nPlacesUB
m_aDigits( m_nPos ) = 0
Next
m_nPos = m_nPlacesUB
End Sub ' reset
'' tick() - increment the current position and deal with carry
Public Sub tick()
m_aDigits( m_nPos ) = m_aDigits( m_nPos ) + 1
If m_aDigits( m_nPos ) > m_aLasts( m_nPos ) Then ' carry to left
For m_nPos = m_nPos - 1 To 0 Step -1
m_aDigits( m_nPos ) = m_aDigits( m_nPos ) + 1
If m_aDigits( m_nPos ) <= m_aLasts( m_nPos ) Then ' carry done
Exit For
End If
Next
For m_nPos = m_nPos + 1 To m_nPlacesUB ' zero to right
m_aDigits( m_nPos ) = 0
Next
m_nPos = m_nPlacesUB ' next increment at utmost right
End If
End Sub ' tick
'' map() - build result array by getting the 'words' for the
'' indices in the current 'digits'
Private Sub map()
Dim nIdx
For nIdx = 0 To m_nPlacesUB
m_aWords( nIdx ) = m_aaItems( nIdx )( m_aDigits( nIdx ) )
Next
End Sub ' map
'' run( nMax ) - reset the odometer, tick/increment it nMax times and
'' display the mapped/translated result
Public Sub run( nMax )
reset
Dim oPad : Set oPad = New cPad.initWW( Len( CStr( nMax ) ) + 1, "L" )
Dim nCnt
For nCnt = 0 To nMax - 1
map
WScript.Echo oPad.pad( nCnt ) & ":", Join( m_aWords )
tick
Next
End Sub ' run
End Class ' cOdoDemo
Some hints/remarks: Think of an odometer that genererates all combinations for 6 (7?) places/digits in numerical order. Now imagine an odometer that lets you specify a sequence/ordered set of 'digits'/words/items for each place/slot. This specification is done by aaItems.
This is the code for cPad, used in .run():
''= cPad - Q&D padding
Class cPad
Private m_nW
Private m_sW
Private m_sS
Private m_nW1
Public Function initWW( nW, sW )
m_nW = nW
m_nW1 = m_nW + 1
m_sW = UCase( sW )
m_sS = Space( nW )
Set initWW = Me
End Function
Public Function initWWC( nW, sW, sC )
Set initWWC = initWW( nW, sW )
m_sS = String( nW, sC )
End Function
Public Function pad( vX )
Dim sX : sX = CStr( vX )
Dim nL : nL = Len( sX )
If nL > m_nW Then
Err.Raise 4711, "cPad::pad()", "too long: " & nL & " > " & m_nW
End If
Select Case m_sW
Case "L"
pad = Right( m_sS & sX, m_nW )
Case "R"
pad = Left( sX & m_sS, m_nW )
Case "C"
pad = Mid( m_sS & sX & m_sS, m_nW1 - ((m_nW1 - nL) \ 2), m_nW )
Case Else
Err.Raise 4711, "cPad::pad() Unknown m_sW: '" & m_sW & "'"
End Select
End Function
End Class ' cPad
Sorry for the missing documentation. I'll try to answer all your question.
Generic solution in 20 lines!
Function Permute(parameters)
Dim results, parameter, count, i, j, k, modulus
count = 1
For Each parameter In parameters
count = count * (UBound(parameter) + 1)
Next
results = Array()
Redim results(count - 1)
For i = 0 To count - 1
j = i
For Each parameter In parameters
modulus = UBound(parameter) + 1
k = j Mod modulus
If Len(results(i)) > 0 Then _
results(i) = results(i) & vbTab
results(i) = results(i) & parameter(k)
j = j \ modulus
Next
Next
Permute = results
End Function
If you only have to worry about those four fixed categories, just use nested for loops.
If the number of categories may change, a recursive solution is easy to define:
permute(index, permutation[1..n], sources[1..n])
1. if index > n then print(permutation)
2. else then
3 for i = 1 to sources[index].length do
4. permutation[index] = sources[index][i]
5. permute(index+1, permutation, sources)
Call with index=0 and permutation empty for best results (sources is an array of arrays containing your categories).
Example:
index = 1
sources = [[blue, red, green], [small, medium, large], [wool, cotton, NULL], [shirt, NULL, NULL]].
permutation = [NULL, NULL, NULL, NULL]
permute(index, permutation, sources)
note: n = 4 because that's how many categories there are
index > n is false, so...
compute length of sources[1]:
sources[1][1] isn't NULL, so...
sources[1][2] isn't NULL, so...
sources[1][3] isn't NULL, so...
sources[1].length = 3
let i = 1... then permutation[1] = sources[1][1] = blue
permute(2, permutation, sources)
etc.

Resources