Data update

Task/ADFGVX-cipher/APL/adfgvx-cipher.apl

@@ -0,0 +1,39 @@
+adfgvx←{
+    n←⎕NS''
+    n.split←↑{⍺≥⍴⍵:⊂⍵ ⋄ (⊂⍺↑⍵),⍺∇⍺↓⍵}
+
+    n.enc←⍺{
+        t←∊(∘.,⍨'ADFGVX')[⊃∘⍸∘(⍺⍺∘=)¨⍵]
+        w←↓⍉((⍴⍵⍵)split t)[;⍋⍵⍵]
+        1↓∊' ',¨w~¨' '
+    }⍵
+
+    n.dec←⍺{
+        t←↓2 split (∊(⍉↑⍵⊆⍨' '≠⍵)[;⍋⍋⍵⍵])~' '
+        ⍺⍺['ADFGVX'∘⍳¨t]
+    }⍵
+
+    n
+}
+
+adfgvx_test←{
+    square←6 6⍴(⎕A,⎕D)[?⍨36]
+    ⎕←'Polybius square:'
+    ⎕←' ─ADFGVX','│┼││││││','A D F G V X' ⍪'─'⍪(11⍴1 0)\square
+    ⎕←''
+
+    key←{
+        file←'e:\unixdict.txt'
+        dict←(~data∊⎕TC)⊆data←⊃⎕NGET file
+        dict←(⍵{⍺=≢⍵}¨dict)/dict
+        dict←({⍵≡∪⍵}¨dict)/dict
+        1⎕C ⊃dict[?⍴dict]
+    }9
+    ⎕←'Key: ',key
+
+    a←square adfgvx key
+
+    ⎕←'Plaintext: ',plaintext←'ATTACKAT1200AM'
+    ⎕←'Encrypted: ',encrypted←a.enc plaintext
+    ⎕←'Decrypted: ',a.dec encrypted
+}

Task/ADFGVX-cipher/Crystal/adfgvx-cipher.cr

@@ -0,0 +1,62 @@
+def make_square
+  # it's a square at heart...
+  (('A'..'Z').to_a + ('0'..'9').to_a).shuffle!
+end
+
+def make_key (size)
+  words = File.open("unixdict.txt") do |f|
+    f.each_line.select {|w| w.size == size && w.chars.to_set.size == size }.to_a
+  end
+  raise "no suitable key found" if words.empty?
+  words.sample
+end
+
+def adfgvx_encrypt (message, square, key)
+  h = "ADFGVX".chars
+  message.chars.flat_map {|ch|
+    row, col = square.index!(ch).divmod(6)
+    [ h[row], h[col] ]
+  }
+    .in_groups_of(key.size)
+    .transpose
+    .zip(key.chars)
+    .sort_by {|_, key| key }
+    .map {|col, _| col.join }
+    .join(" ")
+end
+
+def adfgvx_decrypt (message, square, key)
+  h = "ADFGVX".chars
+  sorted_key = key.chars.sort!
+  cols = message.split.map &.chars
+  max_size = cols.max_of &.size
+  cols.map {|col| col + [nil]*(max_size-col.size) }
+    .zip(sorted_key)
+    .sort_by {|_, ch| key.index! ch }
+    .map {|col, _| col }
+    .transpose
+    .flatten.compact
+    .in_slices_of(2)
+    .map {|(row, col)| square[ h.index!(row)*6 + h.index!(col) ] }
+    .join
+end
+
+def show (title, message, square, key)
+  encrypted = adfgvx_encrypt message, square, key
+  decrypted = adfgvx_decrypt encrypted, square, key
+  puts title
+  puts " - Alphabet: #{square.join}"
+  puts " - Key:      #{key}"
+  puts " - Message:   #{message}"
+  puts " - Encrypted: #{encrypted}"
+  puts " - Decrypted: #{decrypted}"
+  puts
+end
+
+message = "ATTACKAT1200AM"
+
+wiki_square = "NA1C3H8TB2OME5WRPD4F6G7I9J0KLQSUVXYZ".chars
+wiki_key = "PRIVACY"
+
+show "Wikipedia example:", message, wiki_square, wiki_key
+show "Random square and key:", message, make_square, make_key(9)

Task/ADFGVX-cipher/Fortran/adfgvx-cipher.f

@@ -0,0 +1,618 @@
+!
+! ADFGVX Cipher
+! tested with Intel ifx (IFX) 2025.2.1 20250806             on Kubuntu 25.10
+!             GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0   on Kubuntu 25.10
+! VSI Fortran on VMS does not compile it because it cannot handle
+! allocatable character strings.
+! U.B., December 2025
+!==============================================================================
+
+program ADFGVXCipher
+
+  implicit none
+
+  logical, parameter :: DEBUG = .false.     ! set to .true. for reproducable, not random results
+  logical, parameter :: VERBOSE = .false.   ! set this to .true. to print some intermediate results
+  integer, parameter :: maxLen=100          ! Maximum length of any test message (including extensions as 'X')
+
+  integer, parameter :: minPassLen=7, maxPassLen=12   ! Minimum and maximum password length
+
+  ! The complete alphabet of capital letters as used in most western languages, plus numbers 0...9
+  character (len=36), parameter :: Alphabet ='ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567879'
+  character (len=*), parameter :: ADFGVX = 'ADFGVX'
+
+  character (len=maxLen)    :: MsgToEncrypt, DecryptedMsg
+  character (len=2*maxLen) :: EncryptedMsg   ! encrypt makes 2 letters from 1
+  character (len=25)        :: PassPhrase
+  integer, parameter :: ColWidth = 6     ! depends on length of the used alphabet but we use only 36 letters
+
+  character (len=36) :: PolyAlphabet      ! Permutation of Alphabet to represent Polybius square
+  integer :: i
+
+  ! Initialize random number generator once for the entire run-time of the program and all test cases
+  call random_seed()
+
+
+  ! The message to encrypt - for 1 test case
+  ! the plain text message is from the task description
+  MsgToEncrypt = 'ATTACKAT1200AM'
+
+  if (.not. DEBUG) then
+    print  '("Init: DEBUG is .false., i.e. password and Polybius square are randomized.")'
+    PassPhrase = getRandomPassPhrase()       ! select random password from unixdict.txt
+  else
+    ! for DEBUG only: force constant password for reproducible result:
+    print  '("Init: DEBUG is .true., i.e. the code reproduces results of the NIM solution")'
+    PassPhrase = 'EXCURSION'  ! Taken from the NIM solution
+  endif
+
+  print '("Init: PassPhrase for encode and decode is ", A)' , PassPhrase
+
+  if (.not. DEBUG) then
+    call createRandomPolybiusSquare ()       ! Create random Permutation of Alphabet to represent Polybius square
+  else
+    ! For DEBUG only: force constant string for reproducable results
+    ! Both the Alphabet and the password are from the NIM solution.
+    ! If DEBUG is .true., the result of the NIM solution is exactly reproduced.
+    PolyAlphabet =   'XOFPD6VHC40ZJMKRU5IA9YBW3L21NGQTE78S'
+  endif
+
+  call PrintSquare ("Init: Following Polybius square is used for encode/decode:", PolyAlphabet, ColWidth)
+
+  call encode (MsgToEncrypt , EncryptedMsg, PolyAlphabet, PassPhrase)
+  call decode (EncryptedMsg, DecryptedMsg, PolyAlphabet, PassPhrase)
+
+  call printResult (MsgToEncrypt, EncryptedMsg, DecryptedMsg)
+
+contains
+
+
+
+! ==========================================================
+! Find random length of the new password,
+! then pick a random word of this length from the word list
+! ==========================================================
+function getRandomPassPhrase()   result (retval)
+  character (len=maxPassLen) :: retval
+  integer :: leng                                             ! required length of password to pick
+
+  leng = randominInterval (minPassLen, maxPassLen)
+  retval = getRandomWord (leng)
+
+end function getRandomPassPhrase
+
+! ==================================================================================
+! Read the wordlist unixdict.txt and select a random word  with the requested length
+! ==================================================================================
+function getRandomWord (leng) result (retval)
+  integer, intent(in) :: leng
+  character (len=maxPassLen) :: retval
+
+  character(len=100)  :: word                                     ! is longer than expected input word length
+  character (len=maxPassLen), allocatable :: Candidates (:)
+  integer:: capacity, content
+  integer :: io_stat, l, idx, ii
+
+  ! Read all words from unixdict.txt having length "len" and no repeating letters
+  open(unit=10, file='unixdict.txt', status='old', action='read', iostat=io_stat)
+  if (io_stat .ne. 0) then      ! File open MUST be successful, otherwise total program failure.
+     print *, "Error opening file"
+     stop
+  end if
+  capacity = 128
+  call resize (Candidates, maxPassLen, capacity)
+  content = 0
+  do
+    read (10,'(A)', iostat=io_stat)   word               ! ok for both intel and GNU.
+    l = len_trim (word)                                  ! use this instead of Q format
+    if (io_stat < 0) exit    ! EOF: Normal end of this loop
+    if (io_stat > 0) then
+      print *, "Read error" ! ERROR: (never seen)
+      exit
+    end if
+    if (l .ne. leng) cycle
+    if (hasDuplicateChars(word)) cycle
+    if (content .eq. capacity) then
+      capacity = capacity * 2
+      call resize (Candidates, maxPassLen, capacity)
+    end if
+    content = content + 1
+    Candidates (content) = word
+  enddo
+  idx = randominInterval (1, content)
+  retval = candidates (idx)
+  do ii=1, leng
+    if (retval(ii:ii) .ge. 'a' .and. retval(ii:ii) .le. 'z') then
+      retval(ii:ii) = char (ichar(retval(ii:ii)) - ichar('a') + ichar('A'))
+    endif
+  end do
+  close (10)
+
+end function getRandomWord
+
+! ========================================================================
+! Return true if argument word contains duplicate letters, otherwise false.
+! ========================================================================
+function hasDuplicateChars (word) result (itHas)
+  character (len=*), intent(in) :: word
+  logical :: itHas
+  integer :: ii, jj, l
+  l = len_trim(word)
+  do ii=1, l
+    do jj=ii+1, l
+      if (word(ii:ii) .eq. word(jj:jj)) then
+        itHas = .true.
+        return
+      endif
+    end do
+  end do
+  itHas = .false.
+end function hasDuplicateChars
+
+
+  !==============================================================
+  ! Creating a random Polybius square is equivalent with creating
+  ! a random permutation of the used alphabet
+  ! Use the Sattolo algorithm to create such a permutation .
+  !==============================================================
+subroutine createRandomPolybiusSquare ()
+
+  character :: tmp                                      ! for swapping single letters
+
+  integer :: j, k, l                                    ! Helper variables: indices into words, words' length
+
+
+  PolyAlphabet = Alphabet
+  l = len (Alphabet)
+  do j = l, 1, -1                                       ! For all letters from end down to begin
+    k = randominInterval (1, j-1)                       ! Select random letters between 1 and j-1
+    tmp = PolyAlphabet(j:j)                             ! then swap letter at pos j with letter at pos k
+    PolyAlphabet (j:j) = PolyAlphabet (k:k)
+    PolyAlphabet (k:k) = tmp
+  end do
+
+end subroutine createRandomPolybiusSquare
+
+
+
+! =============================================
+! Increase allocated size of string array 'var'
+! =============================================
+subroutine resize(var, sLen, newSize)
+  integer, intent(in)                              :: sLen       ! LEngth of 1 element of string array
+  character (len=sLen), allocatable, intent(inout) :: var(:)     ! The array to be increased
+  integer, intent(in)                              :: newSize    ! The new size of var
+  character (len=sLen), allocatable                :: tmp(:)     ! Temporary storage
+  integer                                          :: oldSize    ! Current array size
+  integer                                          :: ii         ! Loop index
+
+  ! Copy allocated values to temporary, then allocate var with
+  ! new size and copy back saved values.
+  ! Could be done with move_alloc but this would not be portable to OpenVMS Fortran
+
+  if (allocated(var)) then
+    oldSize = size(var)
+  else
+    oldSize = 0
+  end if
+
+  if (newSize .gt. oldSize) then           ! only increment
+    if (oldSize .gt.0) then
+      allocate(tmp (oldSize))
+      tmp(:oldSize) = var(:oldSize)
+      deallocate (var)
+    end if
+    allocate(var(newSize))
+    if (allocated(tmp) .and. allocated (var) ) then
+      oldSize = min(size(tmp, 1), size(var, 1))
+      var(:oldSize) = tmp(:oldSize)
+      deallocate (tmp)
+    end if
+  end if
+end subroutine resize
+
+
+  ! ===========================================================
+  ! Generate random number between @lo and @hi (inclusive)
+  ! Assume Random Number Generator has been initialized before.
+  ! ===========================================================
+function randominInterval (lo, hi) result (r)
+  integer, intent(in) :: lo, hi                         ! the interval
+  integer :: r                                          ! resultant (pseudo-)random number
+  real :: rnd                                           ! Fortran random number generator generates float values
+
+  call random_number (rnd)
+  r = lo + FLOOR((hi+1-lo)*rnd)                         ! We want to choose one between [lo,hi]
+
+end function randominInterval
+
+
+
+! =============================================
+! Encode a given string using the ADFGVX Cipher
+! =============================================
+subroutine encode (argInString, outString, argAlphabet, argPassPhrase)
+  character (len=*), intent(in)  :: argInString     ! The string to encode
+  character (len=*), intent(out) :: outString       ! The resultant encoded text
+  character (len=*), intent(in)  :: argAlphabet     ! The alphabet that makes the Polybius square
+  character (len=*), intent(in) :: argPassPhrase    ! the password used for encode and also decode.
+  integer :: nRow
+  integer :: argLen, passLen, newlen, ii, jj, kk, row, col
+  character(len=2*len(OutString)+len_trim(argPassPhrase))  newAlphabet
+
+  character, dimension(:,:), allocatable :: Matrix, expandedMatrix
+
+  argLen = len_trim (argInString)
+  passLen = len_trim (argPassPhrase)
+  newlen = len(OutString)+len_trim(argPassPhrase)
+  ! 1st step: encode with the given alphabet (resp. the equivalent 6x6 square),
+  ! the output string being the row/col of each letter, expressed in terms of ADFGVX
+  outString = ' '
+  jj = 1
+  do ii=1,argLen
+    call getRC (argInString(ii:ii),row,col, argAlphabet)
+    outString (jj:jj) = ADFGVX (row:row)
+    jj = jj + 1
+    outString (jj:jj) = ADFGVX (col:col)
+    jj = jj + 1
+  end do
+
+  if (VERBOSE) then
+    print '("Encode, first step: ")'
+    do ii=1, arglen
+      write (*,'(A3)', advance='no') ArgInString (ii:ii)
+    end do
+    print *, 'becomes'
+
+    do ii=1, 2*argLen, 2
+      write (*,'(x,A2)', advance='no') outString (ii:ii+1)
+    end do
+    write (*,'(///)')
+  endif
+
+  jj = 1
+  kk = 1
+  newAlphabet = argPassPhrase (:passLen) // outString(:len_trim(outString))
+
+  nRow = (len_trim (newAlphabet) + passLen - 1)/passLen ! Required net number of lines for the Matrix
+  allocate (Matrix (passLen, nRow))
+
+  ! Without any complications: Just accept that last line might be incomplete - complete it with spaces.
+  do row=1, nRow
+    do col=1,passLen
+      if (row .eq. 1 ) then                             ! Top row gets the password
+        Matrix (col,row) = newAlphabet (jj:jj)
+        jj = jj + 1
+      else
+        if (jj .gt. len_trim(newAlphabet)) then         ! Entire new alphabet copied to Matrix
+          Matrix(col,row) = ' '                         ! remaining Matrix is all blank
+        else
+          Matrix (col,row) = newAlphabet (jj:jj)
+          jj = jj + 1
+        endif
+      endif
+    end do
+    if (jj .gt. len_trim(newAlphabet)) exit
+  end do
+  jj = 1
+  do row=1, nRow
+    do col=1,passLen
+      newAlphabet (jj:jj) = Matrix (col,row)
+      jj = jj + 1
+    end do
+  end do
+
+  if (VERBOSE) &
+    call printMatrix ('Encode: This results in a new matrix: ', Matrix, nRow, passLen)
+  ! Sort columns
+  call quicksort_matrix (Matrix, passLen, nRow, 1, passlen)
+
+  if (VERBOSE) &
+    call printMatrix ('Encode: After sorting columns, this becomes: ', Matrix, nRow, passLen)
+
+  jj = 1
+  do row=1, nRow
+    do col=1,passLen
+      newAlphabet (jj:jj) = Matrix (col,row)
+      jj = jj + 1
+    end do
+  end do
+
+  allocate (expandedMatrix (passLen, nRow))
+  ! Initialize al to blank
+  do row=1, 2*kk
+    do col=1,passLen
+      expandedMatrix (col,row) = ' '
+    end do
+  end do
+
+  jj=1
+  do row=1, nRow
+    do col=1,passLen
+      if (jj .le. len_trim(newAlphabet))  then
+        expandedMatrix (col,row) = newAlphabet (jj:jj)
+      else
+        expandedMatrix (col,row) = ' '
+      endif
+      jj = jj + 1
+    end do
+  end do
+
+  outString = ' '
+  jj = 1
+  do col=1,passLen
+    do row=2, nRow
+      if (expandedMatrix (col,row) .ne. ' ') then
+        outString (jj:jj) = expandedMatrix (col,row)
+        jj = jj + 1
+      end if
+    end do
+    outString (jj:jj) = ' '
+    jj = jj + 1
+  end do
+
+end subroutine encode
+
+
+! ==================================================================================
+! Sort columns of a Matrix, taking elements of top row as key to decide "lt" or ge".
+! ==================================================================================
+recursive subroutine quicksort_matrix (mat, ncols, nrows, low, high)
+
+  integer, intent(in) :: ncols,nrows
+  character, dimension (ncols,nrows), intent(inout) :: mat
+
+  integer, intent(in) :: low, high
+  integer :: pivot_index
+  integer :: i, j, mid
+  character :: pivot, temp
+
+  if (low .lt. high) then
+    ! The list is already "almost sorted", so use midlle word as pivot.
+    mid = low + (high-low) / 2
+    pivot = mat (mid,1)
+
+    !Move pivot to the end
+    call swapMat (mat,ncols,nrows,mid,high)
+
+    i = low - 1
+    do j = low, high - 1
+      if (mat(j,1) .le. pivot) then
+        i = i + 1
+        call swapMat (mat,ncols,nrows,i,j)
+      end if
+    end do
+
+    call swapMat (mat,ncols,nrows,i+1,high)
+    pivot_index = i + 1
+
+    call quicksort_matrix (mat, ncols,nrows, low, pivot_index - 1)
+    call quicksort_matrix (mat, ncols,nrows,  pivot_index + 1, high)
+  end if
+end subroutine quicksort_matrix
+
+! ===============================================
+! Swap two columns of a Matrix (Used for sorting)
+! ===============================================
+subroutine swapMat (mat,ncols,nrows,col1,col2)
+  integer, intent(in) :: ncols,nrows                        ! Size of ...
+  character, dimension (ncols,nrows), intent(inout) :: mat  ! ... the matrix
+  integer, intent(in) :: col1, col2                         ! The 2 columns to swap
+
+  character :: tmp                                    ! Helpers to swap 2 elements
+  integer :: row
+
+  ! early return in trivial noop case
+  if (col1 .eq. col2) return
+
+  do row=1, nrows                                    ! Swap all elements of col 1 and col 2
+    tmp = mat (col1,row)
+    mat (col1,row) = mat(col2,row)
+    mat(col2,row) = tmp
+  end do
+
+end subroutine swapMat
+
+! =======================================================
+! Decode a given (encoded) string using the ADFGVX Cipher
+! =======================================================
+subroutine decode (argInString, outString, argAlphabet, argPassPhrase)
+  character (len=*), intent(in)  :: argInString     ! The encoded string to decode
+  character (len=*), intent(out) :: outString       ! Result of the decode
+  character (len=*), intent(in)  :: argAlphabet     ! The Polybius Square to encode and decode
+  character (len=*), intent(in) :: argPassPhrase    ! The Password used to encode and decode
+  character (len=MaxLen) :: tmpString               ! Temporary torage for intermediate result
+  character, allocatable :: Matrix (:,:)            ! Matrix to constructed from input string
+  character (len=:),allocatable :: SortedPassPhrase ! The password after sorting its letters
+  integer :: nRow, passLen                          ! NMUmbner of rows and columns of above Matrix
+  integer :: inLen, col,row, ii, jj, idx            ! Length of input string, and some helpers
+
+  ! Estimate input string lengths
+  inLen = len_trim (argInString)
+  passLen = len_trim (argPassPhrase)
+
+  outString = ' '
+  nRow = (inLen + (passLen-1)) / passLen  + 1     ! 1 extra for top row = password
+
+  allocate (Matrix (passLen, nRow))
+
+  ! Initialize entire matrix
+  do col=1,passLen
+    do row=1, nRow
+      Matrix (col,row) = ' '
+    end do
+    ! Fill the column as far as required
+  end do
+
+
+  ! The columns of the result matrix are sorted as password letters and
+  ! the sorted password letters makeup top row of th is matrix
+  SortedPassPhrase = argPassPhrase
+  call  quicksort_matrix (SortedPassPhrase, passlen,  1, 1, passlen)
+
+  row=1
+  do col=1, passLen
+    Matrix (col,row) = SortedPassPhrase(col:col)
+  end do
+
+  ! Set rest ( row 2 ff.) of the Matrix: column by column
+  jj = 1
+  do col=1,passLen
+    row = 2
+    do while (argInString (jj:jj) .ne. ' ')
+      Matrix (col,row) = argInString (jj:jj)
+      jj = jj + 1
+      row = row + 1
+    enddo
+    jj = jj + 1
+  end do
+
+  if (VERBOSE) &
+    call printMatrix ('Decode: the reconstructed Code matrix is ', Matrix, nROw, passLen)
+
+  ! We know the columns of this matrix are sorted together with the password
+  !
+  ! restore the correct order of thet sorted matrix
+  call UndoSort (Matrix, passLen, nRow, argPassPhrase, passlen)
+
+  if (VERBOSE) &
+    call printMatrix ('Decode: After Undo Sorting, this becomes', Matrix, nRow, passLen)
+
+  ! The matrix is in the correct order now, so its rows, one by one,  represent the first encoded string
+  !
+  jj = 1
+  tmpString = ' '
+  do row = 2, nRow          ! Skip top row (=Passwprd)
+    do col=1,passLen
+      tmpString (jj:jj) = Matrix(col,row)
+      jj = jj + 1
+    end do
+  end do
+
+  ! Now we have the encoded string, each 2 letters are row/col in ADFGVX scheme
+  jj = 1
+  do ii=1, len_trim(tmpString), 2
+    row = index (ADFGVX, tmpString(ii:ii))
+    col = index (ADFGVX, tmpString((ii+1) : (ii+1)))
+    outString (jj:jj) = getChar (row,col,argAlphabet)   ! Decode from row/col to clear text
+    jj = jj + 1
+  end do
+end subroutine decode
+
+! =============================================================================
+! Print all nRow x nCol elements of a Matrix, togehther with a descriptive text
+! =============================================================================
+subroutine printMatrix (comment, Matrix, nRow, nCol)
+  integer, intent(in) :: nRow, nCol
+  character (len=*), intent(in) :: Comment
+  character , intent(in) :: Matrix (nCol, nRow)
+  integer :: r, c
+
+  write (*,'(/A/)')  Comment
+  do r=1, nROw
+    do c=1, nCol
+      write (*, '(A2)', advance='no')  Matrix(c,r)
+    end do
+    write (*,*)
+  end do
+end subroutine printMatrix
+
+!=============================================================
+! Matrix has been sorted before, with top row as key elements.
+! Here undo that sort operation
+!=============================================================
+subroutine UndoSort (Matrix, nCol, nRow, argPassPhrase, passLen)
+  integer, intent(in) :: nCol, nRow, passLen
+  character, intent(inout)  :: Matrix (nCol, nROw)
+  character                 :: resultMatrix (nCol, nROw)
+
+  character (len=passLen), intent(in) :: argPassPhrase
+
+  integer :: ii, jj, kk
+
+  do ii=1, passLen
+    ! find whatever letter should be at pos ii within the unscrambled string
+    jj = index (argPassPhrase, Matrix(ii, 1) )
+    ! so letter "PassPhrase(jj:jj)" should be at pos ii in line 1 of Matrix
+    if (jj .ne. ii) then
+      do kk=1, nRow
+        resultMatrix (jj,kk) = Matrix(ii,kk)
+      end do
+    else
+      do kk=1, nRow
+        resultMatrix (jj,kk) = Matrix(jj,kk)
+      end do
+    endif
+  end do
+  matrix = resultMatrix
+end subroutine UndoSort
+
+
+! ======================================================
+! Get Row and Column  of a letter in the Polybius square
+! ======================================================
+subroutine getRC (c,row,col, argAlphabet)
+  character, intent(in) :: c
+  integer, intent(out) :: row,col
+  character (len=*), intent(in)  :: argAlphabet             ! Argument to use for encoding
+  integer :: idx
+
+  idx = index (argAlphabet, c) - 1
+
+  row = 1 + idx / ColWidth
+  col = 1 + mod (idx, ColWidth)
+
+end subroutine getRC
+
+! ==================================================
+! Return letter in row column of the Polybius square
+! ==================================================
+function getChar (row,column,argAlphabet) result (chr)
+  integer, intent(in) :: row, column
+  character (len=*), intent(in)  :: argAlphabet             ! Argument to use for encoding
+  character :: chr
+  integer :: idx
+
+  idx = (row-1) * ColWidth + column
+  chr = argAlphabet (idx:idx)
+
+end function getChar
+
+! ===========================================
+! Print original, encoded and decoded strings
+! ===========================================
+subroutine printResult (m1,m2,m3)
+  character (len=*), intent(in) :: m1,m2,m3
+  write (*,'("Original:  ", A)')  m1(:len_trim(m1))
+  write (*,'(" Encoded:  ", A)')  m2(:len_trim(m2))
+  write (*,'(" Decoded:  ", A)')  m3(:len_trim(m3))
+  print *
+end subroutine printResult
+
+! ================================================================================
+! Print the resulting Polybius square based on the alphabet used for encode/decode
+! ================================================================================
+subroutine PrintSquare (Comment, Alp, cw)
+  character (len=*), intent(in) :: Comment
+  character (len=*), intent(in)  :: Alp
+  integer, intent(in) :: cw                                     ! column width for dormatted display
+  integer:: ii, l
+
+  l = len_trim(alp)
+  write (*,'(/A/)')  Comment
+  Write (*, "('   A D F G V X', /,' +------------',/  A, '|')", advance='no') ADFGVX (1:1)
+  do ii=1, l
+    write (*, '(A2)', advance='no')  Alp(ii:ii)
+    if (mod (ii, cw) .eq. 0) then
+      if (ii .ne. l)  then
+        write (*,'(/,A1,"|")', advance='no') ADFGVX (1 +  ii/cw:1 +  ii/cw)
+      else
+        write (*,*) ! just EOL
+      endif
+    endif
+  end do
+  print *                                                       ! one extra blank line
+end subroutine PrintSquare
+
+
+end program ADFGVXCipher

Task/ADFGVX-cipher/Free-Pascal-Lazarus/adfgvx-cipher.pas

@@ -0,0 +1,198 @@
+program adfgvxcipher;
+
+uses
+  SysUtils,
+  Classes;
+
+const
+  ADFGVX = 'ADFGVX';
+  ALPHABET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
+  MESSAGE = 'ATTACKAT1200AM';
+
+type
+  //tPolybiusarr = array[1..6,1..6] of string;
+  tPolybiusarr = array[1..6, 1..6] of char;
+
+  procedure init_Polybius(var Polybius: tPolybiusarr);
+
+    procedure ShuffleString(var S: string);
+    var
+      i, j: integer;
+      c: char;
+    begin
+      for i := Length(S) downto 2 do
+      begin
+        j := Random(i) + 1;  // 1..i
+        c := S[i];
+        S[i] := S[j];
+        S[j] := c;
+      end;
+    end;
+
+  var
+    ShuffledAlphabet: string;
+    x, y, i: integer;
+  begin
+    ShuffledAlphabet := ALPHABET;
+    ShuffleString(ShuffledAlphabet);
+    i := 1;
+    for x := 1 to 6 do
+      for y := 1 to 6 do
+      begin
+        Polybius[x, y] := ShuffledAlphabet[i];
+        Inc(i);
+      end;
+  end;
+
+  procedure PrintPolybius(Polybius: tPolybiusarr);
+  var
+    x, y: integer;
+    ch: char;
+  begin
+    writeln('The 6 x 6 Polybius square:');
+    writeln;
+    Write('  |');
+    for ch in ADFGVX do
+      Write(ch: 2);
+    writeln;
+    writeln('---------------');
+    for x := 1 to 6 do
+    begin
+      Write(ADFGVX[x], ' |');
+      for y := 1 to 6 do
+      begin
+        Write(Polybius[x, y]: 2);
+      end;
+      writeln;
+    end;
+  end;
+
+  function CreateKey(size: integer): string;
+
+    procedure FilterList(var lst: TStringList; size: integer);
+
+      function HasRepeatedCharacters(const str: string): boolean;
+      var
+        seen: array[0..255] of boolean;
+        i: integer;
+        c: byte;
+      begin
+        FillChar(seen, SizeOf(seen), False);
+        for i := 1 to Length(str) do
+        begin
+          c := Ord(str[i]);
+          if seen[c] then
+            Exit(True);    // repeated character found
+          seen[c] := True;
+        end;
+        Result := False;   // no repeats
+      end;
+
+    var
+      x: integer;
+    begin
+      for x := lst.Count - 1 downto 0 do
+        if (length(lst[x]) <> size) or HasRepeatedCharacters(lst[x]) then lst.Delete(x);
+    end;
+
+  const
+    FNAME = 'unixdict.txt';
+  var
+    list: TStringList;
+  begin
+    if (size < 7) or (size > 12) then
+    begin
+      writeln('Key should contain between 7 and 12 letters, both inclusive.');
+      halt;
+    end;
+    list := TStringList.Create;
+    list.LoadFromFile(FNAME);
+    filterlist(list, size);
+    Result := UpperCase(list[random(list.Count)]);
+    list.Free;
+  end;
+
+  function FindCharachter(ch: char; polybius: tPolybiusarr): string;
+  var
+    x, y: integer;
+  begin
+    for x := 1 to 6 do
+      for y := 1 to 6 do
+        if polybius[x, y] = ch then
+          exit(ADFGVX[x] + ADFGVX[y]);
+  end;
+
+  function Encrypt(plainText, key: string; Polybius: tPolybiusarr): string;
+  var
+    ch: char;
+    str: string;
+    lst: TStringList;
+    x, keylength: integer;
+  begin
+    str := '';
+    keylength := length(key);
+    lst := TStringList.Create;
+    for x := 1 to keylength do
+      lst.Add(key[x]);
+    x := 0;
+    for ch in plainText do
+    begin
+      lst[x] := lst[x] + FindCharachter(ch, Polybius);
+      Inc(x);
+      if x = keylength then x := 0;
+    end;
+    lst.Sort;
+    writeln;
+    for x := 0 to keylength - 1 do
+      str := str + lst[x] + ' ';
+    Result := TrimRight(str);
+    lst.Free;
+  end;
+
+  function Decrypt(encryptedTex, key: string; polybius: tPolybiusarr): string;
+    // Note: simplified decryption logic for demonstration purposes
+    // need some work for longer messages
+  var
+    lst, tmp: TStringList;
+    ch: char;
+    s, str: string;
+  begin
+    lst := TStringList.Create;
+    tmp := TStringList.Create;
+    lst.AddDelimitedtext(encryptedTex, ' ', True);
+    for ch in key do
+      for str in lst do
+        if str[1] = ch then
+        begin
+          tmp.Add(str);
+          break;
+        end;
+    Result := '';
+    s := '';
+    for str in tmp do
+    begin
+      Result := Result + polybius[pos(str[2], ADFGVX), pos(str[3], ADFGVX)];
+      if length(str) > 3 then s := s + polybius[pos(str[4], ADFGVX), pos(str[5], ADFGVX)];
+    end;
+    Result := Result + s;
+    lst.Free;
+    tmp.Free;
+  end;
+
+var
+  Polybius: tPolybiusarr;
+  key, encryptedMessage, decryptedMessage: string;
+
+begin
+  Randomize;
+  init_Polybius(Polybius);
+  PrintPolybius(Polybius);
+  key := createkey(Random(12 - 7 + 1) + 7); //set length of word to 7 - 12
+  encryptedMessage := Encrypt(MESSAGE, key, Polybius);
+  decryptedMessage := Decrypt(encryptedMessage, key, polybius);
+  writeln('The key is              : ', key);
+  writeln('the plain message is    : ', MESSAGE);
+  writeln('the encrypted message is: ', encryptedMessage);
+  writeln('the decrypted message is: ', decryptedMessage);
+
+end.

Task/ADFGVX-cipher/Mathematica/adfgvx-cipher.math

@@ -0,0 +1,24 @@
+encrypt[plaintext_, polybius_, key_] := Module[{fraction, fractioned},
+   fraction = Thread[Characters[polybius] -> Tuples[Characters["ADFGVX"], 2]];
+   fractioned = Partition[Flatten[Characters[plaintext] /. fraction], UpTo[StringLength[key]]];
+   StringJoin[Flatten[Part[Flatten[fractioned, {2}], Ordering[Characters[key]]]]]];
+
+decrypt[encrypted_, polybius_, key_] := Module[{perm, colLengths, fractioned, defraction},
+   perm = Ordering[Characters[key]];
+   colLengths = Length /@ Part[Flatten[Partition[Characters[encrypted], UpTo[Length[perm]]], {2}], perm];
+   fractioned = Flatten[Part[TakeList[Characters[encrypted], colLengths], InversePermutation[perm]], {2}];
+   defraction = Thread[Tuples[Characters["ADFGVX"], 2] -> Characters[polybius]];
+   StringJoin[Partition[Flatten[fractioned], 2] /. defraction]];
+
+words = ReadList["unixdict.txt", Word];
+key = Select[words, StringLength[#] == 9 && DuplicateFreeQ[Characters[#]] &] // RandomChoice;
+polybius = StringJoin@RandomSample@Characters["ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"];
+plaintext = "ATTACKAT1200AM";
+encrypted = encrypt[plaintext, polybius, key];
+decrypted = decrypt[encrypted, polybius, key];
+
+Print["Key: ", key];
+Print["Polybius: ", polybius];
+Print["Plaintext: ", plaintext];
+Print["Encrypted: ", encrypted];
+Print["Decrypted: ", decrypted];

Task/ADFGVX-cipher/R/adfgvx-cipher.r

@@ -0,0 +1,173 @@
+# The ADFGVX cipher.
+# See also eg. https://www.nku.edu/~christensen/092hnr304%20ADFGVX.pdf
+
+# ADFGVX class using R6
+library(R6)
+
+ADFGVX <- R6Class("ADFGVX",
+  public = list(
+    polybius = NULL,
+    pdim = NULL,
+    key = NULL,
+    keylen = NULL,
+    alphabet = NULL,
+    encode = NULL,
+    decode = NULL,
+
+    # Constructor
+    initialize = function(s, k, alph = "ADFGVX") {
+      self$polybius <- toupper(strsplit(s, "")[[1]])
+      self$pdim <- floor(sqrt(length(self$polybius)))
+      self$alphabet <- toupper(strsplit(alph, "")[[1]])
+
+      # Create encoding dictionary
+      self$encode <- list()
+      for (i in 1:self$pdim) {
+        for (j in 1:self$pdim) {
+          char <- self$polybius[(i - 1) * self$pdim + j]
+          self$encode[[char]] <- c(self$alphabet[i], self$alphabet[j])
+        }
+      }
+
+      # Create decoding dictionary
+      self$decode <- list()
+      for (char in names(self$encode)) {
+        key_str <- paste(self$encode[[char]], collapse = "")
+        self$decode[[key_str]] <- char
+      }
+
+      stopifnot(self$pdim^2 == length(self$polybius) &&
+                self$pdim == length(self$alphabet))
+
+      self$key <- toupper(strsplit(k, "")[[1]])
+      self$keylen <- length(self$key)
+    },
+
+    # Encrypt with the ADFGVX cipher
+    encrypt = function(s) {
+      chars_upper <- toupper(strsplit(s, "")[[1]])
+      chars_filtered <- chars_upper[chars_upper %in% self$polybius]
+
+      # Encode characters
+      chars <- unlist(lapply(chars_filtered, function(c) self$encode[[c]]))
+
+      # Create column vectors
+      colvecs <- list()
+      for (i in 1:self$keylen) {
+        indices <- seq(i, length(chars), by = self$keylen)
+        colvecs[[self$key[i]]] <- chars[indices]
+      }
+
+      # Sort by key
+      sorted_names <- sort(names(colvecs))
+      result <- unlist(lapply(sorted_names, function(name) colvecs[[name]]))
+
+      return(paste(result, collapse = ""))
+    },
+
+    # Decrypt with the ADFGVX cipher
+    decrypt = function(s) {
+      chars <- toupper(strsplit(s, "")[[1]])
+      chars <- chars[chars %in% self$alphabet]
+
+      sortedkey <- sort(self$key)
+      order <- sapply(sortedkey, function(ch) which(self$key == ch)[1])
+      originalorder <- sapply(self$key, function(ch) which(sortedkey == ch)[1])
+
+      # Calculate strides (column lengths)
+      div_result <- length(chars) %/% self$keylen
+      rem_result <- length(chars) %% self$keylen
+      strides <- sapply(order, function(i) {
+        div_result + ifelse(rem_result >= i, 1, 0)
+      })
+
+      # Calculate starts and ends of columns
+      starts <- c(1, cumsum(strides[-length(strides)]) + 1)
+      ends <- starts + strides - 1
+
+      # Get reordered columns
+      cols <- lapply(originalorder, function(i) {
+        chars[starts[i]:ends[i]]
+      })
+
+      # Recover the rows
+      nrows <- (length(chars) - 1) %/% self$keylen + 1
+      pairs <- c()
+      for (i in 1:nrows) {
+        for (j in 1:self$keylen) {
+          if ((i - 1) * self$keylen + j > length(chars)) break
+          pairs <- c(pairs, cols[[j]][i])
+        }
+      }
+
+      # Decode pairs
+      result <- c()
+      for (i in seq(1, length(pairs) - 1, by = 2)) {
+        pair_str <- paste(pairs[i:(i+1)], collapse = "")
+        result <- c(result, self$decode[[pair_str]])
+      }
+
+      return(paste(result, collapse = ""))
+    }
+  )
+)
+
+# Main execution
+set.seed(123)  # For reproducibility
+POLYBIUS <- paste(sample(strsplit("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789", "")[[1]]),
+                  collapse = "")
+
+# Get dictionary words - try multiple sources
+get_valid_key <- function() {
+  # Try to read unixdict.txt if it exists
+  if (file.exists("unixdict.txt")) {
+    dict_words <- readLines("unixdict.txt")
+  } else {
+    # Use sample words if file doesn't exist
+    dict_words <- c("absolutes", "abruption", "abundance", "abysmally",
+                    "acrobatic", "algorithm", "ambiguity", "amplitude",
+                    "ancestory", "archetype", "asynchron", "auctioned",
+                    "backbone", "backfired", "backlights", "bandwidth",
+                    "benchmark", "biography", "birthplace", "blasphemy",
+                    "boulevard", "bricklaying", "broadcast", "butchering",
+                    "cauterize", "chemicals", "chromatic", "clipboard",
+                    "completing", "conjugate", "copyright", "daughters",
+                    "debuggers", "delimiters", "demograph", "dialyzing",
+                    "dictionary", "education", "equations", "factorize",
+                    "geography", "goshdarn", "graciously", "graphed",
+                    "hampshire", "imploding", "indexable", "jeculates",
+                    "keyboards", "labyrinth", "livestock", "logarithm",
+                    "machinery", "molecules", "nightmare", "obscurity",
+                    "particles", "quizboard", "racehorst", "reduction",
+                    "savepoint", "sectional", "shipyard", "splatting",
+                    "substance", "technology", "ulceration", "vineyard",
+                    "warehouse", "workplace", "xanthopsy", "yachtsmen")
+  }
+
+  # Filter for 9-letter words with unique characters
+  valid_words <- dict_words[sapply(dict_words, function(w) {
+    n <- nchar(w)
+    n == 9 && length(unique(strsplit(w, "")[[1]])) == n
+  })]
+
+  if (length(valid_words) == 0) {
+    stop("No valid 9-letter words with unique characters found")
+  }
+
+  return(toupper(sample(valid_words, 1)))
+}
+
+KEY <- get_valid_key()
+
+# Create cipher and encrypt/decrypt
+SECRETS <- ADFGVX$new(POLYBIUS, KEY)
+message <- "ATTACKAT1200AM"
+
+cat("Polybius:", POLYBIUS, ", Key:", KEY, "\n")
+cat("Message:", message, "\n")
+
+encoded <- SECRETS$encrypt(message)
+decoded <- SECRETS$decrypt(encoded)
+
+cat("Encoded:", encoded, "\n")
+cat("Decoded:", decoded, "\n")