#------------------------------------------------------------------------------
#$Author: andrius $
#$Date: 2022-01-12 17:12:40 +0200 (Wed, 12 Jan 2022) $
#$Revision: 9120 $
#$URL: svn+ssh://www.crystallography.net/home/coder/svn-repositories/cod-tools/tags/v3.8.0/src/lib/perl5/COD/CIF/Data/AtomList.pm $
#------------------------------------------------------------------------------
#*
#  Construct a common data structure, representing list of atoms in
#  a CIF file.
#**

package COD::CIF::Data::AtomList;

use strict;
use warnings;
use COD::Algebra::Vector qw( modulo_1 );
use COD::AtomProperties;
use COD::CIF::Data qw( get_cell );
use COD::CIF::Tags::Manage qw( contains_data_item
                               get_data_value
                               has_unknown_value
                               new_datablock
                               set_loop_tag
                               set_tag
                               get_item_loop_index );
use COD::CIF::Tags::Print qw( print_cif );
use COD::Spacegroups::Symop::Algebra qw( symop_invert symop_mul
                                         symop_vector_mul );
use COD::Spacegroups::Symop::Parse qw( string_from_symop
                                       symop_from_string
                                       symop_string_canonical_form );
use COD::Fractional qw( symop_ortho_from_fract );
use Clone qw( clone );
use List::MoreUtils qw( any );

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
    assemblies
    atom_array_from_cif
    atom_groups
    atom_is_disordered
    atoms_are_alternative
    copy_atom
    datablock_from_atom_array
    dump_atoms_as_cif
    extract_atom
    generate_cod_molecule_data_block
    get_atom_chemical_type
    uniquify_atom_names
);

my @shallow_copied_keys = qw( symop_list f2o site_symops symop );
my %shallow_copied_keys = map { $_ => 1 } @shallow_copied_keys;

#===============================================================#
# Extracts atom information from the CIF file.
#
# Accepts
#     atom_label - atom site label or atom site type symbol from the CIF file
#     values     - a hash where a data from the CIF file is stored
#     number     - a number of the current atom
#     f2o        - conversion matrix from fractional to Cartesian coordinates
#     options    - a hash with control options
#
# Accepted control options:
#       atom_properties
#                           A reference to a hash that contains various
#                           properties (weight, bond length, etc.) of chemical
#                           elements. Used to check if the resolved chemical
#                           type is a valid one. %COD::AtomProperties::atoms
#                           is used by default.
#       atom_data_items
#                           A reference to an array of data names that identify
#                           data items that should be used while constructing
#                           the atom data structure. This option is mainly used
#                           to circumvent problems introduced by faulty input
#                           files. In case the option is not provided, the
#                           hardcoded values are used.
#       allow_unknown_chemical_types
#                           Include atoms for which a recognisable chemical
#                           type could not be resolved. If this option is
#                           disabled, a die signal is issued upon encountering
#                           such atoms. The option if off by default.
#       assume_full_occupancy
#                           Set atom occupancy to '1' for all atoms that do
#                           not have an explicitly declared occupancy.
#       remove_precision
#                           Remove standard uncertainty values from
#                           atom_site_occupancy and atom_site_U_iso_or_equiv
#                           tag values.
#       modulo_1
#                           Apply modulo 1 operation on fractional coordinates
#                           to position the atom in the '555' octant.
#       symop_list
#                           A reference to a symop list value that should be
#                           set to the 'symop_list' property.
#       concat_refinement_flags
#                           Store the values of refinement_flags,
#                           refinement_flags_posn, refinement_flags_adp and
#                           refinement_flags_occupancy tags as a single
#                           concatenated value of the 'refinement_flags'
#                           field.
#       use_cod_molecule_tags
#                           Set atom tags that are generated by the
#                           cod_molecule script.
#
# Returns a hash $atom:{
#                       label=>'C1',
#                       site_label=>'C1';
#                       chemical_type=>'C',
#                       atom_site_type_symbol = 'C',
#                       coordinates_fract=>[1.0, 1.0, 1.0],
#                       unity_matrix_applied=>1,
#                       transform_matrices=>[ [
#                           [ 1, 0, 0, 0 ],
#                           [ 0, 1, 0, 0 ],
#                           [ 0, 0, 1, 0 ],
#                           [ 0, 0, 0, 1 ] ] ],
#                       assembly=>"A", # "."
#                       group=>"1", # "."
#                       }

sub extract_atom
{
    my($atom_label, $values, $number, $f2o, $options) = @_;

    $options = {} unless $options;
    if ( !defined $options->{atom_properties} ) {
        $options->{atom_properties} = \%COD::AtomProperties::atoms;
    };

    my %atom_info;
    my @atom_xyz;

    foreach ( qw( _atom_site_fract_x
                  _atom_site_fract_y
                  _atom_site_fract_z ) ) {
        push ( @atom_xyz, $values->{$_}[$number] );
        $atom_xyz[-1] =~ s/[(][0-9]+[)]$//;
    }

    if( $options->{modulo_1} ) {
        @atom_xyz = map { modulo_1($_) } @atom_xyz;
    }

    $atom_info{'coordinates_fract'}     = \@atom_xyz;
    $atom_info{'name'}                  = $atom_label;
    $atom_info{'site_label'}            = $atom_label;
    $atom_info{'cell_label'}            = $atom_label;
    $atom_info{'index'}                 = $number;
    $atom_info{'symop'}                 =
      [
        [ 1, 0, 0, 0 ],
        [ 0, 1, 0, 0 ],
        [ 0, 0, 1, 0 ],
        [ 0, 0, 0, 1 ]
      ];
    $atom_info{'symop_id'}              = 1;
    $atom_info{'unity_matrix_applied'}  = 1;
    $atom_info{'translation_id'}        = '555';
    $atom_info{'translation'}           = [ 0, 0, 0 ];
    if( $options->{'symop_list'} ) {
        $atom_info{'symop_list'} = $options->{'symop_list'};
    }

    $atom_info{f2o} = $f2o;
    if( $atom_xyz[0] eq '.' ||
        $atom_xyz[1] eq '.' ||
        $atom_xyz[2] eq '.' ) {
        $atom_info{coordinates_ortho} = [ '.', '.', '.' ];
    } elsif( $atom_xyz[0] eq '?' ||
             $atom_xyz[1] eq '?' ||
             $atom_xyz[2] eq '?' ) {
        $atom_info{coordinates_ortho} = [ '?', '?', '?' ];
    } else {
        $atom_info{coordinates_ortho} =
            symop_vector_mul( $f2o, \@atom_xyz );
    }

    if( exists $values->{'_atom_site_type_symbol'} &&
        defined $values->{'_atom_site_type_symbol'}[$number] ) {
        $atom_info{'atom_site_type_symbol'} =
            $values->{'_atom_site_type_symbol'}[$number];
    }

    # FIXME: artificial CIF data block is constructed from $values, as
    # extract_atom() does not receive the whole CIF data block
    $atom_info{chemical_type} = get_atom_chemical_type( { values => $values },
                                                    $number,
                                                    $options );
    $atom_info{oxidation} = get_atom_oxidation( { values => $values }, $number );

    $atom_info{assembly} = '.';
    $atom_info{group}    = '.';

    my %to_copy_atom_site = (
        _atom_site_disorder_assembly     => 'assembly',
        _atom_site_disorder_group        => 'group',
        _atom_site_occupancy             => 'atom_site_occupancy',
        _atom_site_U_iso_or_equiv        => 'atom_site_U_iso_or_equiv',
        _atom_site_symmetry_multiplicity => 'multiplicity',
        _atom_site_attached_hydrogens    => 'attached_hydrogens',
        _atom_site_refinement_flags      => 'refinement_flags',
        _atom_site_refinement_posn       => 'refinement_flags_position',
        _atom_site_refinement_adp        => 'refinement_flags_adp',
        _atom_site_refinement_occupancy  => 'refinement_flags_occupancy',
        _atom_site_calc_flag             => 'calc_flag',
    );

    # The optional data item list contains data items that have been deemed
    # suitable for atom structure construction by external subroutines
    if ( defined $options->{'atom_data_items'} ) {
        my %merged_items;
        for my $proper_item ( @{$options->{'atom_data_items'}} ) {
            if ( defined $to_copy_atom_site{ $proper_item } ) {
                $merged_items{ $proper_item } = $to_copy_atom_site{ $proper_item };
            } else {
                $merged_items{ $proper_item } = $proper_item;
            }
        }
        %to_copy_atom_site = %merged_items
    }

    for my $tag (keys %to_copy_atom_site) {
        next if !exists $values->{$tag};
        $atom_info{$to_copy_atom_site{$tag}} = $values->{$tag}[$number];
    }

    # Take _atom_site_symmetry_multiplicity (if not '.' or '?')
    # The field was previously processed and saved in the atom structure
    if( exists $atom_info{'multiplicity'} &&
        $atom_info{'multiplicity'} ne '?' &&
        $atom_info{'multiplicity'} ne '.' ) {
        $atom_info{'_atom_site_symmetry_multiplicity'} =
                                            $atom_info{'multiplicity'}
    }

    if( $options->{remove_precision} ) {
        for my $key (qw( atom_site_occupancy atom_site_U_iso_or_equiv )) {
            next if !exists $atom_info{$key};
            $atom_info{$key} =~ s/\([0-9]+\)$//;
        }
    }

    if( $options->{concat_refinement_flags} ) {
        my %refinement_flags;
        for my $key (qw( refinement_flags
                         refinement_flags_posn
                         refinement_flags_adp
                         refinement_flags_occupancy )) {
            next if !exists $atom_info{$key};
            next if $atom_info{$key} eq '?' || $atom_info{$key} eq '.';
            map { $refinement_flags{$_} = 1 }
                split '', $atom_info{$key};
            delete $atom_info{$key};
        }
        if( %refinement_flags ) {
            $atom_info{refinement_flags} =
                join( '', sort keys %refinement_flags );
        }
    }

    if( !exists $atom_info{atom_site_occupancy} &&
        $options->{assume_full_occupancy} ) {
        $atom_info{atom_site_occupancy} = 1;
    }

    return \%atom_info;
}

#===============================================================#
# Performs several checks on values at the given index position
# to determine is the they are suitable for constructing an atom structure.
#
# Accepts:
#   values
#           Reference to the 'values' field of the parsed CIF structure.
#   number
#           Atom number (index) in the 'values' structure.
#   criteria
#           Reference to a hash with criteria options.
#
# Accepted options are:
#       has_zero_occupancies
#               Check if the atom has unknown ('?'), not applicable ('.')
#               or zero (0.0) occupancy.
#       has_dummy_flag
#               Check if the atom is a dummy atom (has the
#               _atom_site_calc_flag value 'dum'.
#       has_unknown_coordinates
#               Check if at least one component of the fractional coordinates
#               is unknown ('?').
#       has_dummy_coordinates
#               Check if at least one component of the fractional coordinates
#               is unknown ('.').
#       is_hydrogen
#               Check if the atom is hydrogen.
#
# Returns:
#   0 if the values at the given index did not satisfy any of the criteria,
#   1 otherwise.
##
sub is_atom_excludable
{
    my ( $values, $number, $criteria ) = @_;

    # Check for zero occupancies
    if( $criteria->{'has_zero_occupancies'} &&
        defined $values->{'_atom_site_occupancy'} ) {
        my $occupancy = $values->{'_atom_site_occupancy'}[$number];
        $occupancy =~ s/[(][0-9]+[)]$//; # remove precision
        if( $occupancy eq '?' || $occupancy eq '.' || $occupancy == 0.0 ) {
            return 1;
        }
    }

    # Check for dummy atoms
    if( $criteria->{'has_dummy_flag'} &&
        defined $values->{'_atom_site_calc_flag'} ) {
        if ( $values->{'_atom_site_calc_flag'}[$number] eq 'dum' ) {
            return 1;
        }
    }

    # Check for unknown coordinates
    if( $criteria->{'has_unknown_coordinates'} ) {
        foreach ( qw( _atom_site_fract_x
                      _atom_site_fract_y
                      _atom_site_fract_z ) ) {
            if( $values->{$_}[$number] eq '?' ) {
                return 1;
            }
        }
    }

    # Check for dummy coordinates
    if( $criteria->{'has_dummy_coordinates'} ) {
        foreach ( qw( _atom_site_fract_x
                      _atom_site_fract_y
                      _atom_site_fract_z ) ) {
            if( $values->{$_}[$number] eq '.' ) {
                return 1;
            }
        }
    }

    # Check for hydrogen
    if( $criteria->{'is_hydrogen'} &&
        get_atom_chemical_type( { values => $values },
                                $number,
                                { allow_unknown_chemical_types => 1 } ) eq 'H' ) {
        return 1;
    }

    return 0;
}

# ============================================================================ #
# Constructs an array of atom description data structures from a CIF data block.
#
# Returns an array of
#
#   $atom_info = {
#                   site_label=>"C1",
#                   name=>"C1_2",
#                   chemical_type=>"C",
#                   atom_site_type_symbol = "C",
#                   coordinates_fract=>[1.0, 1.0, 1.0],
#                   unity_matrix_applied=>1,
#                   assembly=>"A", # "."
#                   group=>"1", # "."
#                   multiplicity=>"1",
#                   multiplicity_ratio=>"1",
#              }
#
sub atom_array_from_cif($$)
{
    my( $datablock, $options ) = @_;

    $options = {} unless $options;

    my $values = $datablock->{values};
    # Get the unit cell information and construct the fract->ortho and
    # ortho->fract conversion matrices:
    my @cell = get_cell( $values );
    my $f2o = symop_ortho_from_fract( @cell );

    if( $options->{homogenize_transform_matrices} ) {
        push( @{$f2o->[0]}, 0 );
        push( @{$f2o->[1]}, 0 );
        push( @{$f2o->[2]}, 0 );
        push( @$f2o, [0,0,0,1] );
    }

    # Determine which atom site label data item is present and which can be
    # used for identifying atoms:
    my $atom_site_tag;
    if( exists $values->{'_atom_site_label'} ) {
        $atom_site_tag = '_atom_site_label';
    } elsif( exists $values->{'_atom_site_type_symbol'} ) {
        $atom_site_tag = '_atom_site_type_symbol';
        warn 'WARNING, data item \'_atom_site_label\' was not found -- a '
           . 'serial number will be appended to the \'_atom_site_type_symbol\' '
           . 'data item values to make atom labels' . "\n";
    } else {
        die 'ERROR, neither data item \'_atom_site_label\' nor '
          . 'data item \'_atom_site_type_symbol\' was found' . "\n";
    }

    my $atom_data_items = [
        '_atom_site_type_symbol',
        '_atom_site_disorder_assembly',
        '_atom_site_disorder_group',
        '_atom_site_occupancy',
        '_atom_site_U_iso_or_equiv',
        '_atom_site_symmetry_multiplicity',
        '_atom_site_attached_hydrogens',
        '_atom_site_refinement_flags',
        '_atom_site_refinement_posn',
        '_atom_site_refinement_adp',
        '_atom_site_refinement_occupancy',
        '_atom_site_calc_flag',
    ];

    # filter out data items describing the atom are all located in the same loop
    $atom_data_items = filter_proper_atom_items( $datablock, $atom_site_tag, $atom_data_items );
    $options->{'atom_data_items'} = $atom_data_items;

    if ( !contains_data_item( $datablock, '_atom_site_fract_x' ) ||
         !contains_data_item( $datablock, '_atom_site_fract_y' ) ||
         !contains_data_item( $datablock, '_atom_site_fract_z' ) ) {
        die 'ERROR, fractional atomic coordinates could not be extracted -- ' .
            'at least one of the data items ' .
            "['_atom_site_fract_x', '_atom_site_fract_y', '_atom_site_fract_z'] " .
            'was not found' . "\n";
    }

    my $atom_labels = $values->{$atom_site_tag};

    my $exclusion_criteria = {
        'has_dummy_flag'          => $options->{'exclude_dummy_atoms'},
        'has_unknown_coordinates' => $options->{'exclude_unknown_coordinates'},
        'has_dummy_coordinates'   => $options->{'exclude_dummy_coordinates'},
        'has_zero_occupancies'    => $options->{'exclude_zero_occupancies'},
        'is_hydrogen'             => $options->{'exclude_hydrogens'}
    };

    my @atom_list;
    for (my $i = 0; $i < @{$atom_labels}; $i++) {
        # exclude atoms that fit certain criteria (dummy atoms, atoms with
        # unknown coordinates, atoms with zero occupancies, etc.)
        next if ( is_atom_excludable( $values, $i, $exclusion_criteria ) );

        my $label;
        if ( $atom_site_tag eq '_atom_site_type_symbol' ) {
            $label = $values->{$atom_site_tag}[$i] . $i;
        } else {
            $label = $values->{$atom_site_tag}[$i];
        }

        my $atom_info;
        eval {
            $atom_info = extract_atom( $label, $values, $i, $f2o, $options );
        };
        if ($@) {
            $@ =~ s/^[A-Z]+,\s*//;
            chomp($@);
            if ($options->{'continue_on_errors'}) {
                warn "WARNING, $@ -- atom will be excluded\n";
            } else {
                die "ERROR, $@\n";
            }
        };
        # Some of the code used to return undef from extract_atom in case
        # an atom has to be skipped, so this is silently done in order to
        # stay compatible with the code.
        next if !defined $atom_info;

        # Some of _cod_molecule_* tags override tags from _atom_site_* loop,
        # thus former have to be copied AFTER the latter.
        if( $options->{'use_cod_molecule_tags'} ) {
            set_cod_molecule_atom_fields($atom_info, $values);
        }

        push( @atom_list, $atom_info );
    }

    # NOTE: currently, only the 'atom_site_type_symbol' field is removed
    # in case all of the field values are unknown '?'. It should be discussed
    # if this behaviour should be extended to all unknown/undef atom fields
    if ( ! any { defined $_->{'atom_site_type_symbol'} &&
                         $_->{'atom_site_type_symbol'} ne '?' } @atom_list ) {
        for my $atom ( @atom_list ) {
            delete $atom->{'atom_site_type_symbol'};
        }
    }

    if( $options->{'uniquify_atom_names'} ) {
        return uniquify_atom_names( \@atom_list, $options->{'uniquify_atoms'} );
    } else {
        return \@atom_list;
    }
}

##
# Filters out data items out of the given item list that do not appear
# in the same loop as the atom loop key item. A warning is raised for
# each removed item.
#
# @param $data_frame
#       Data frame as returned by the COD::CIF::Parser.
# @param $atom_loop_key_item
#       Data name of the item that serves as the atom loop key.
#       Normally, it should be either _atom_site_label or
#       _atom_site_type_symbol.
# @param $extra_atom_items
#       Reference to an array of data names that should be checked.
# @return $same_loop_items
#       Reference to an array of data names that reside in the same loop
#       as the atom loop key item.
##
sub filter_proper_atom_items
{
    my ( $data_frame, $atom_loop_key_item, $extra_atom_items ) = @_;

    my $atom_loop_index = get_item_loop_index( $data_frame, $atom_loop_key_item );
    $atom_loop_index = -1 if !defined $atom_loop_index;

    my @same_loop_items;
    for my $atom_item ( @{$extra_atom_items} ) {
        next if !contains_data_item( $data_frame, $atom_item );

        my $extra_loop_index = get_item_loop_index( $data_frame, $atom_item );
        $extra_loop_index = -1 if !defined $extra_loop_index;

        if ( $atom_loop_index eq $extra_loop_index ) {
            push @same_loop_items, $atom_item;
        } else {
            warn "data item '$atom_item' is not located in the same loop " .
                 "as the '$atom_loop_key_item' data item -- " .
                 "data item '$atom_item' values will be excluded from " .
                 "the atom descriptions" . "\n";
        }
    }

    return \@same_loop_items;
}

#===============================================================#
# Constructs a CIF data block from atom array data structure.
sub datablock_from_atom_array
{
    my( $atoms ) = @_;

    my $has_disorder =
        any { (defined $_->{group}    && $_->{group}    ne '.') ||
              (defined $_->{assembly} && $_->{assembly} ne '.') } @$atoms;
    my $has_attached_hydrogens = any { $_->{attached_hydrogens} } @$atoms;

    my %has_key;
    for my $key ( qw( atom_site_occupancy
                      atom_site_type_symbol
                      atom_site_U_iso_or_equiv
                      calc_flag
                      refinement_flags
                      refinement_flags_adp
                      refinement_flags_occupancy
                      refinement_flags_position ) ) {
        $has_key{$key} = any { exists $_->{$key} && $_->{$key} ne '.' } @$atoms;
    }

    my $datablock = new_datablock( 'atom_array' );

    set_loop_tag( $datablock, '_atom_site_label', '_atom_site_label',
                  [ map { $_->{name} } @$atoms ] );
    set_loop_tag( $datablock,
                  '_atom_site_type_symbol',
                  '_atom_site_label',
                  [ map { $_->{atom_site_type_symbol} } @$atoms ] )
        if $has_key{atom_site_type_symbol};

    if( !(any { (defined $_->{coordinates_fract}[0] &&
                         $_->{coordinates_fract}[0] ne '?') ||
                (defined $_->{coordinates_fract}[1] &&
                         $_->{coordinates_fract}[1] ne '?') ||
                (defined $_->{coordinates_fract}[2] &&
                         $_->{coordinates_fract}[2] ne '?') } @$atoms) &&
         (any { (defined $_->{coordinates_ortho}[0] &&
                         $_->{coordinates_ortho}[0] ne '?') ||
                (defined $_->{coordinates_ortho}[1] &&
                         $_->{coordinates_ortho}[1] ne '?') ||
                (defined $_->{coordinates_ortho}[2] &&
                         $_->{coordinates_ortho}[2] ne '?') } @$atoms) ) {
        set_loop_tag( $datablock,
                      '_atom_site_Cartn_x',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_ortho}[0]
                                    ? $_->{coordinates_ortho}[0] : '?'}
                            @$atoms ] );
        set_loop_tag( $datablock,
                      '_atom_site_Cartn_y',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_ortho}[1]
                                    ? $_->{coordinates_ortho}[1] : '?'}
                            @$atoms ] );
        set_loop_tag( $datablock,
                      '_atom_site_Cartn_z',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_ortho}[2]
                                    ? $_->{coordinates_ortho}[2] : '?'}
                            @$atoms ] );
    } else {
        set_loop_tag( $datablock,
                      '_atom_site_fract_x',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_fract}[0]
                                    ? $_->{coordinates_fract}[0] : '?'}
                            @$atoms ] );
        set_loop_tag( $datablock,
                      '_atom_site_fract_y',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_fract}[1]
                                    ? $_->{coordinates_fract}[1] : '?'}
                            @$atoms ] );
        set_loop_tag( $datablock,
                      '_atom_site_fract_z',
                      '_atom_site_label',
                      [ map { defined $_->{coordinates_fract}[2]
                                    ? $_->{coordinates_fract}[2] : '?'}
                            @$atoms ] );
    }
    set_loop_tag( $datablock,
                  '_atom_site_U_iso_or_equiv',
                  '_atom_site_label',
                  [ map { $_->{atom_site_U_iso_or_equiv} } @$atoms ] )
        if $has_key{atom_site_U_iso_or_equiv};
    set_loop_tag( $datablock,
                  '_atom_site_occupancy',
                  '_atom_site_label',
                  [ map { exists $_->{calc_flag} && $_->{calc_flag} eq 'dum'
                            ? '.' : $_->{atom_site_occupancy} } @$atoms ] )
        if $has_key{atom_site_occupancy};

    # Refinement flags
    set_loop_tag( $datablock,
                  '_atom_site_refinement_flags',
                  '_atom_site_label',
                  [ map { $_->{refinement_flags} } @$atoms ] )
        if $has_key{refinement_flags};
    set_loop_tag( $datablock,
                  '_atom_site_refinement_flags_posn',
                  '_atom_site_label',
                  [ map { $_->{refinement_flags_position} } @$atoms ] )
        if $has_key{refinement_flags_position};
    set_loop_tag( $datablock,
                  '_atom_site_refinement_flags_adp',
                  '_atom_site_label',
                  [ map { $_->{refinement_flags_adp} } @$atoms ] )
        if $has_key{refinement_flags_adp};
    set_loop_tag( $datablock,
                  '_atom_site_refinement_flags_occupancy',
                  '_atom_site_label',
                  [ map { $_->{refinement_flags_occupancy} } @$atoms ] )
        if $has_key{refinement_flags_occupancy};

    set_loop_tag( $datablock,
                  '_atom_site_disorder_assembly',
                  '_atom_site_label',
                  [ map { $_->{assembly} } @$atoms ] ) if $has_disorder;
    set_loop_tag( $datablock,
                  '_atom_site_disorder_group',
                  '_atom_site_label',
                  [ map { $_->{group} } @$atoms ] ) if $has_disorder;
    set_loop_tag( $datablock,
                  '_atom_site_attached_hydrogens',
                  '_atom_site_label',
                  [ map { $_->{attached_hydrogens} } @$atoms ] )
        if $has_attached_hydrogens;
    set_loop_tag( $datablock,
                  '_atom_site_calc_flag',
                  '_atom_site_label',
                  [ map { $_->{calc_flag} } @$atoms ] )
        if $has_key{calc_flag};

    return $datablock;
}

##
# Generates a data block containing the _cod_molecule_* data items from the
# atom array data structure.
#
# @param $atoms
#       Reference to an atom array as returned by
#       the atom_array_from_cif() subroutine.
#
# @return $data_block
#       Reference to a CIF data block as constructed by the
#       COD::CIF::Tags::Manage module.
##
sub generate_cod_molecule_data_block
{
    my ( $atoms ) = @_;

    my $has_disorder = any { $_->{'group'} ne '.' ||
                             $_->{'assembly'} ne '.' } @$atoms;
    my %has_key;
    for my $key ( qw(
                      multiplicity
                      multiplicity_ratio
                  ) ) {
        $has_key{$key} = any { exists $_->{$key} && $_->{$key} ne '.' } @$atoms;
    }

    my $data_block = new_datablock( 'cod_molecule' );
    # Set _cod_molecule_* data items
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_label',
                  '_cod_molecule_atom_label',
                  [ map { $_->{name} } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_orig_label',
                  '_cod_molecule_atom_label',
                  [ map { $_->{site_label} } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_symmetry',
                  '_cod_molecule_atom_label',
                  [ map { $_->{symop_id} . '_' .
                          $_->{translation_id} } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_symop_id',
                  '_cod_molecule_atom_label',
                  [ map { $_->{symop_id} } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_symop_xyz',
                  '_cod_molecule_atom_label',
                  [ map { symop_string_canonical_form(
                            string_from_symop( $_->{symop} ) ) }
                        @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_transl_id',
                  '_cod_molecule_atom_label',
                  [ map { $_->{translation_id} } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_transl_x',
                  '_cod_molecule_atom_label',
                  [ map { $_->{translation}[0] } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_transl_y',
                  '_cod_molecule_atom_label',
                  [ map { $_->{translation}[1] } @$atoms ] );
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_transl_z',
                  '_cod_molecule_atom_label',
                  [ map { $_->{translation}[2] } @$atoms ] );
    if ( $has_key{'multiplicity'} ) {
        set_loop_tag( $data_block,
                      '_cod_molecule_atom_mult',
                      '_cod_molecule_atom_label',
                      [ map { $_->{multiplicity} } @$atoms ] )
    };
    if ( $has_key{'multiplicity_ratio'} ) {
        set_loop_tag( $data_block,
                      '_cod_molecule_atom_mult_ratio',
                      '_cod_molecule_atom_label',
                      [ map { $_->{multiplicity_ratio} } @$atoms ] );
    }
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_assembly',
                  '_cod_molecule_atom_label',
                  [ map { $_->{assembly} } @$atoms ] ) if $has_disorder;
    set_loop_tag( $data_block,
                  '_cod_molecule_atom_group',
                  '_cod_molecule_atom_label',
                  [ map { $_->{group} } @$atoms ] ) if $has_disorder;

    # Site symops
    if( any { $_->{site_symops} && @{$_->{site_symops}} > 0 } @$atoms ) {
        my @transform_labels;
        my @transform_symops;
        foreach my $atom ( @$atoms ) {
            foreach my $symop ( @{$atom->{site_symops}} ) {
                push @transform_labels, $atom->{name};
                push @transform_symops, symop_string_canonical_form(
                                            string_from_symop( $symop ) );
            }
        }
        set_loop_tag( $data_block,
                      '_cod_molecule_transform_label',
                      '_cod_molecule_transform_label',
                      \@transform_labels );
        set_loop_tag( $data_block,
                      '_cod_molecule_transform_symop',
                      '_cod_molecule_transform_label',
                      \@transform_symops );
    }

    return $data_block;
}

# ============================================================================ #
# Renames atoms which have identical names by adding a unique suffix to the
# original atom name.
#
# Accepts:
#   $init_atoms
#                   A reference to an array of atom structures, for which
#                   the names should be uniquified. Example of the accepted
#                   atom structure:
#
#                   $atom_info = {
#                         site_label=>"C1",
#                         name=>"C1_2",
#                         chemical_type=>"C",
#                         coordinates_fract=>[1.0, 1.0, 1.0],
#                         unity_matrix_applied=>1,
#                         assembly=>"A", # "."
#                         group=>"1", # "."
#                   }
#   $uniquify_atom
#                   Flag value denoting whether atoms with identical names
#                   should be renamed. If set to false, warnings about atoms
#                   having identical names are issued, but the atoms themselves
#                   are not renamed.
#
# Returns:
#   \@checked_initial_atoms
#                   A reference to an array of atom structures.
#
#
sub uniquify_atom_names($$)
{
    my ($init_atoms, $uniquify_atoms) = @_;

    my $max_label_suffix = 30000; # Maximum number to be appended to labels
                                  # when trying to produce unique names.

    my @checked_initial_atoms;

    my %used_labels;
    my %labels_to_be_renamed;

    foreach my $atom (@{$init_atoms})
    {
        my $atom_copy = copy_atom( $atom );
        my $label = $atom->{name};

        push( @checked_initial_atoms, $atom_copy );

        if( ! exists $used_labels{$label} ) {
            $used_labels{$label}{atoms} = [ $atom_copy ];
        } else {
            push( @{$used_labels{$label}{atoms}}, $atom_copy );
            warn "WARNING, atom label '$label' is not unique\n";

            $labels_to_be_renamed{$label} ++;
        }
        $used_labels{$label}{count} ++;
    }

    if( $uniquify_atoms ) {
        foreach my $label (sort keys %labels_to_be_renamed) {
            foreach my $renamed_atom (@{$used_labels{$label}{atoms}}) {
                my $id = 0;
                while( exists $used_labels{$label . '_' .$id} &&
                       $id <= $max_label_suffix ) {
                    $id ++;
                }
                if( $id > $max_label_suffix ) {
                    die "ERROR, could not generate unique atom name for ".
                        "atom '$label', even after $id iterations\n";
                }
                my $new_label = $label . '_' . $id;
                warn "WARNING, renaming atom '$label' to '$new_label'\n";
                $renamed_atom->{name}       = $new_label;
                $renamed_atom->{site_label} = $new_label;
                $used_labels{$new_label}{count} ++;
            }
        }
    }

    return \@checked_initial_atoms;
}

##
# Determines the chemical type of an atom based on the CIF data block values.
#
# @param $data_block
#       Reference to a data block as returned by the COD::CIF::Parser.
# @param $index
#       Index of the atom in the ATOM_SITE category loop.
# @param $options
#       Reference to a hash of options. The following options are recognised:
#       {
#         # Reference to a hash that contains all recognised
#         # atom chemical types.
#         # Default: %COD::AtomProperties::atoms
#           'atom_properties' => {
#               'H'  => { ... },
#               'D'  => { ... },
#               'He' => { ... },
#               ...
#           }
#         # Boolean value denoting if unrecognised chemical types
#         # should be allowed or if they should raise a fatal error.
#         # Default: 0
#           'allow_unknown_chemical_types' => 0
#       }
# @return
#       Chemical type of the atom with the provided loop index.
##
sub get_atom_chemical_type
{
    my( $data_block, $index, $options ) = @_;

    my $atom_properties = \%COD::AtomProperties::atoms;

    $options = {} unless $options;
    if( exists $options->{'atom_properties'} ) {
        $atom_properties = $options->{'atom_properties'};
    }

    my $values = $data_block->{'values'};
    my $atom_type;
    if( contains_data_item( $data_block, '_atom_site_type_symbol' ) &&
        !has_unknown_value( $data_block, '_atom_site_type_symbol', $index ) ) {
        $atom_type = get_data_value( $values, '_atom_site_type_symbol', $index );
    }

    if( !defined $atom_type &&
        contains_data_item( $data_block, '_atom_site_label' ) ) {
        $atom_type = get_data_value( $values, '_atom_site_label', $index );
    }

    if( defined $atom_type && $atom_type =~ m/^([A-Za-z]{1,2})/ ) {
        $atom_type = ucfirst lc $1;
    }

    if( !exists $atom_properties->{$atom_type} &&
        !$options->{'allow_unknown_chemical_types'} ) {
        die 'ERROR, could not determine chemical type for atom \'' .
            get_data_value( $values, '_atom_site_label', $index ) .
            "'\n";
    }

    return $atom_type;
}

##
# Generates alternative atom sets based on the disorder information.
# Atom sets are constructed by selecting all ordered atoms and a single
# disorder group from each assembly.
#
# If there is only one disorder assembly then a separate atom set is
# generated for each disorder group. Alternatively, if there is more
# than one disorder assembly then only a subset of all possible atom
# sets is generated that includes the most plausible combinations.
# The plausibility of a combination is determine based on the occupancy
# and atom count of the disorder groups with higher atom occupancy
# taking precedence over the higher atom count. Occupancy of a disorder
# group is considered to be equal to the highest occupancy of any atom
# from that group. If all other criteria match, disorder group with
# a lexicographically smaller name is preferred.
#
# The subset generation algorithm can be illustrated with the following
# example. There are two disorder assemblies 'A' (3 groups) and
# 'B' (2 groups) with differing occupancies and sizes:
#
# A = [ { 'name' => 1, 'occupancy' => 0.2, 'size' => 5 },
#       { 'name' => 2, 'occupancy' => 0.6, 'size' => 3 },
#       { 'name' => 3, 'occupancy' => 0.2, 'size' => 6 } ];
# B = [ { 'name' => 1, 'occupancy' => 0.6, 'size' => 2 },
#     [ { 'name' => 2. 'occupancy' => 0.4, 'size' => 3 } ];
#
# The following combinations will be returned in the following order:
# (2,1) # Best from A, best from B
# (3,1) # Second best from A, best from B
# (1,2) # Worst from A, worst from B
#
# @param $initial_atoms
#       Reference to an atom array as returned by
#       the atom_array_from_cif() subroutine.
# @return $atom_groups
#       Reference to a data structure of the following form:
#
#       # An array of different atom sets where each set
#       # takes the form of an atom array data structure
#       # as returned by the atom_array_from_cif().
#       [
#         [
#           {
#             'site_label' => 'C1_A1',
#             'name' => 'C1_A1_2',
#             'chemical_type' => 'C',
#             'coordinates_fract' => [1.0, 1.0, 1.0],
#             'unity_matrix_applied' => 1,
#             'assembly' => 'A',
#             'group' => '1',
#           },
#           # ...
#         ],
#         # ...
#         [
#           {
#             'site_label' => 'C1_A2',
#             'name' => 'C1_A2_2',
#             'chemical_type' => 'C',
#             'coordinates_fract' => [0.5, 0.5, 0.5],
#             'unity_matrix_applied' => 1,
#             'assembly' => 'A',
#             'group' => '2',
#           },
#           # ...
#         ]
#       ]
##
sub atom_groups
{
    my ($initial_atoms) = @_;

    my $assemblies = assemblies($initial_atoms);

    if((keys %{$assemblies}) == 0) {
        my @one_assembly;
        push @one_assembly, $initial_atoms;
        return \@one_assembly;
    }

    my @ordered_atoms;
    my %disordered_atoms;
    for my $atom (@{$initial_atoms}) {
        if ($atom->{'group'} eq '.') {
            push @ordered_atoms, $atom;
        } else {
            my $assembly = $atom->{'assembly'};
            my $group = $atom->{'group'};
            push @{$disordered_atoms{$assembly}{$group}}, $atom;
        }
    }

    $assemblies = sort_disorder_assembly_groups(
                        $assemblies,
                        \%disordered_atoms
                  );
    my @keys = sort { ($a eq '.') ? -1 : ($b eq '.') ? 1 : $a cmp $b }
               keys %{$assemblies};

    my @atom_sets;
    if(@keys == 1) {
        my $assembly = $keys[0];
        my $groups = $assemblies->{$assembly};
        for my $group (@{$groups}) {
            push @atom_sets, $disordered_atoms{$assembly}{$group};
        }
    } else {
        my $atom_set_count = 0;
        for my $assembly (@keys) {
            my $groups = $assemblies->{$assembly};
            if ($atom_set_count < @{$groups}) {
                $atom_set_count = @{$groups};
            }
        }

        for (my $i = 0; $i < $atom_set_count; $i++) {
            my @atom_set;
            for my $assembly (@keys) {
                my $group;
                my @groups = reverse @{$assemblies->{$assembly}};
                if($i < @groups) {
                    $group = $groups[$i];
                } else {
                    $group = $groups[-1];
                }
                push @atom_set, @{$disordered_atoms{$assembly}{$group}};
            }
            push @atom_sets, \@atom_set;
        }
        @atom_sets = reverse @atom_sets;
    }

    # Append atoms which do not belong to any group or assembly
    for my $atom_set (@atom_sets) {
        push @{$atom_set}, @ordered_atoms;
    }

    return \@atom_sets;
}

##
# Sorts disorder groups of each disorder assembly in order of decreasing
# plausibility. The plausibility of a disorder group is determined based
# on the atom occupancy and atom count of the group with higher atom
# occupancy taking precedence over the higher atom count. Occupancy of
# a disorder group is considered to be equal to the highest occupancy
# of any atom from that group. If all other criteria match, disorder
# group with a lexicographically smaller name is preferred.
#
# @param $assemblies
#       Reference to a data structure that contains disorder assembly
#       information as returned by the assemblies() subroutine.
# @param $disordered_atoms
#       Reference to a data structure of the following form:
#       {
#         # Name of the disorder group
#           'A' => {
#             # Name of the disorder assembly
#               '1' => [
#                     # Atoms that belong to the disorder group as
#                     # returned by the extract_atom() subroutine.
#                        {
#                          'site_label' => 'C1_A1',
#                          'name' => 'C1_A1_2',
#                          'chemical_type' => 'C',
#                          'coordinates_fract' => [1.0, 1.0, 1.0],
#                          'unity_matrix_applied' => 1,
#                          'assembly' => 'A',
#                          'group' => '1',
#                        },
#                        # ...
#                      ],
#               '2' => [
#
#                      ],
#           },
#           'B' => {
#               '1' => [
#                        # ...
#                      ],
#               '2' => [
#                        # ...
#                      ],
#               '3' => [
#                        # ...
#                      ],
#           }
#       }
# @return
#       Reference to the input $assemblies data structure with
#       the disorder groups of each disorder assembly sorted
#       in the order of decreasing plausibility.
##
sub sort_disorder_assembly_groups
{
    my ($assemblies, $disordered_atoms) = @_;

    for my $assembly (sort keys %{$assemblies}) {
        my %max_group_occupancy;
        my %group_size;
        my @groups = @{$assemblies->{$assembly}};
        for my $group (@groups) {
            my $all_occupancies_match = 1;
            for my $atom (@{$disordered_atoms->{$assembly}{$group}}) {
                my $occupancy = $atom->{'atom_site_occupancy'};
                if ( !defined $occupancy || $occupancy eq '?' ) {
                    $occupancy = 1;
                } elsif ( $occupancy eq '.' ) {
                    $occupancy = 0;
                } else {
                    # Remove precision
                    $occupancy =~ s/[(][0-9]+[)]$//;
                }

                if ( !defined $max_group_occupancy{$group} ) {
                    $max_group_occupancy{$group} = $occupancy;
                } elsif ( $max_group_occupancy{$group} < $occupancy ) {
                    $max_group_occupancy{$group} = $occupancy;
                    $all_occupancies_match = 0;
                }
            }
            if ( !$all_occupancies_match ) {
                warn 'WARNING, not all atoms in disorder assembly ' .
                     "'$assembly' group '$group' have the same occupancy\n";
            }
            $group_size{$group} =
                        scalar @{$disordered_atoms->{$assembly}{$group}};
        }

        my @sorted_indexes = sort {
            $max_group_occupancy{$groups[$a]} <=>
            $max_group_occupancy{$groups[$b]} ||
            $group_size{$groups[$a]} <=> $group_size{$groups[$b]} ||
            $groups[$b] cmp $groups[$a]
        } 0..$#groups;

        @groups = reverse @groups[@sorted_indexes];

        $assemblies->{$assembly} = \@groups;
    }

    return $assemblies;
}

sub get_atom_oxidation
{
    my( $dataset, $number ) = @_;

    return if !contains_data_item( $dataset, '_atom_site_type_symbol' );
    return if has_unknown_value( $dataset, '_atom_site_type_symbol', $number );

    my $values = $dataset->{values};
    my $atom_type = get_data_value( $values, '_atom_site_type_symbol', $number );
    return if !defined $atom_type;

    if( contains_data_item( $dataset, '_atom_type_symbol' ) &&
        contains_data_item( $dataset, '_atom_type_oxidation_number' ) ) {
        my( $i ) = grep { $_ eq $atom_type }
                        0..$#{$values->{_atom_type_symbol}};
        if( defined $i &&
            defined get_data_value( $values, '_atom_type_oxidation_number', $i ) ) {
            return  get_data_value( $values, '_atom_type_oxidation_number', $i );
        }
    }

    if( $atom_type =~ m/^([A-Za-z]{1,2})(?:([0-9])([+-]))/ ) {
        return int( $3 . $2 );
    }

    return;
}

# ============================================================================ #
# Returns a hash of all possible assemblies and groups:
# %assemblies = ( A => [1,2,3],
#                 . => [1,2]);

sub assemblies
{
    my ($init_atoms) = @_;

    my %assemblies;

    foreach my $atom (@$init_atoms)
    {
        if(not exists $assemblies{$atom->{assembly}})
        {
            my @groups;
            $assemblies{$atom->{assembly}} = \@groups;
        }
    }

    my @keys = sort { ($a eq '.') ? -1 : ($b eq '.') ? 1 : $a cmp $b }
               keys %assemblies;

    for my $assembly (@keys)
    {
        my %unique_groups;

        foreach my $atom (@$init_atoms)
        {
            if((not exists $unique_groups{$atom->{group}}) &&
               ($assembly eq $atom->{assembly}) &&
               ($atom->{group} ne '.'))
            {
                $unique_groups{$atom->{group}} = $atom->{group};
                push(@{$assemblies{$assembly}}, $atom->{group});
            }
        }
    }

    for my $assembly (@keys)
    {
        if(@{$assemblies{$assembly}} == 0)
        {
            delete $assemblies{$assembly};
        }
    }

   return \%assemblies;
}

# ============================================================================ #
# Modifies the atom hash structure to include information generated by
# the 'cif_molecule' script and stored in the '_cod_molecule_*' tags.
#
# Accepts:
#   $atom_info
#                   Reference to the hash containing the atom information.
#   $values
#                   Reference to the 'values' field of the parsed CIF structure.
#
# Returns:
#   This subroutine acts as a procedure and does not return any values.
##
sub set_cod_molecule_atom_fields
{
    my ($atom_info, $values) = @_;

    my $index = $atom_info->{'index'};

    my %to_copy_cod_molecule = (
        '_cod_molecule_atom_orig_label' => 'original_label',
        '_cod_molecule_atom_assembly'   => 'assembly',
        '_cod_molecule_atom_group'      => 'group',
        '_cod_molecule_atom_mult'       => 'multiplicity',
        '_cod_molecule_atom_mult_ratio' => 'multiplicity_ratio',
        '_cod_molecule_atom_symop_id'   => 'symop_id',
        '_cod_molecule_atom_transl_id'  => 'translation_id',
    );

    for my $tag (keys %to_copy_cod_molecule) {
        next if !exists $values->{$tag};
        $atom_info->{$to_copy_cod_molecule{$tag}} = $values->{$tag}[$index];
    }

    my @transform_matrices;
    if( defined $values->{'_cod_molecule_atom_symop_xyz'} ) {
        @transform_matrices = ( $values->{'_cod_molecule_atom_symop_xyz'}[$index] );
    }

    if( defined $values->{'_cod_molecule_transform_label'} &&
        defined $values->{'_cod_molecule_transform_symop'} ) {
        for my $i (0..$#{$values->{'_cod_molecule_transform_label'}}) {
            if( $values->{'_cod_molecule_transform_label'}[$i] ne
                $atom_info->{'site_label'} ) {
                    next
            }
            my $symop = $values->{'_cod_molecule_transform_symop'}[$i];
            if( @transform_matrices ) {
                my $orig_symop = symop_from_string( $transform_matrices[0] );
                my $symop_mat = symop_from_string( $symop );
                my $product = symop_mul( $orig_symop, $symop_mat );
                $symop = string_from_symop( $product );
            }
            push @transform_matrices, $symop;
        }
    }

    if( @transform_matrices ) {
        $atom_info->{'transform_matrix'} = [
            map { symop_from_string( $_ ) } @transform_matrices
        ];
        $atom_info->{'transform_matrix_inv'} = [
            map { symop_invert( $_ ) } @{$atom_info->{transform_matrix}}
        ];
    }

    if( defined $values->{'_cod_molecule_atom_transl_x'} &&
        defined $values->{'_cod_molecule_atom_transl_y'} &&
        defined $values->{'_cod_molecule_atom_transl_z'} ) {
        $atom_info->{'translation'} = [
            $values->{'_cod_molecule_atom_transl_x'}[$index],
            $values->{'_cod_molecule_atom_transl_y'}[$index],
            $values->{'_cod_molecule_atom_transl_z'}[$index],
         ];
     }

    return;
}

#===============================================================#
# Copies atom and returns the same instance of it (different object, same props)

# Accepts a hash $atom_info = {
#                       name=>"C1_2",
#                       site_label=>"C1",
#                       chemical_type=>"C",
#                       coordinates_fract=>[1.0, 1.0, 1.0],
#                       coordinates_ortho=>[5.0, -1.3, 1.7],
#                       transform_matrices=>[ [
#                           [ 1, 0, 0, 0 ],
#                           [ 0, 1, 0, 0 ],
#                           [ 0, 0, 1, 0 ],
#                           [ 0, 0, 0, 1 ] ] ],
#                       unity_matrix_applied=>1,
#                       symop_id=>1
#                       assembly=>"A", # "."
#                       group=>"1", # "."
#                       }

# Returns a hash $new_atom_info = {
#                       name=>"C1_2",
#                       site_label=>"C1",
#                       chemical_type=>"C",
#                       coordinates_fract=>[1.0, 1.0, 1.0],
#                       coordinates_ortho=>[5.0, -1.3, 1.7],
#                       transform_matrices=>[ [
#                           [ 1, 0, 0, 0 ],
#                           [ 0, 1, 0, 0 ],
#                           [ 0, 0, 1, 0 ],
#                           [ 0, 0, 0, 1 ] ] ],
#                       unity_matrix_applied=>1,
#                       symop_id=>1,
#                       assembly=>"A", # "."
#                       group=>"1", # "."
#                       }
sub copy_atom
{
    my($old_atom) = @_;

    if( ref $old_atom ne 'HASH' ) {
        die 'atom must be represented as a hash reference';
    }

    my $atom_copy = {};

    for my $key ( keys %$old_atom ) {
        if( exists $shallow_copied_keys{$key} ) {
            $atom_copy->{$key} = $old_atom->{$key};
        } else {
            $atom_copy->{$key} = clone( $old_atom->{$key} );
        }
    }

    return $atom_copy;
}

#===============================================================#
# Returns true if atom is disordered, false otherwise
sub atom_is_disordered($)
{
    my( $atom ) = @_;
    return exists $atom->{assembly} &&
           exists $atom->{group} &&
           $atom->{group} ne '.';
}

#===============================================================#
# Check whether atoms belong to the same disorder assembly and
# are alternative (belong to different groups of same assembly).
sub atoms_are_alternative($$)
{
    my( $atom1, $atom2 ) = @_;
    return atom_is_disordered( $atom1 ) &&
           atom_is_disordered( $atom2 ) &&
           $atom1->{assembly} eq $atom2->{assembly} &&
           $atom1->{group} ne $atom2->{group};
}

sub dump_atoms_as_cif
{
    my ($datablock_name, $atom_list, $cell) = @_;

    my $datablock = new_datablock( $datablock_name );

    set_tag( $datablock, '_space_group_name_H-M_alt', 'P 1' );

    my @cell_tags = qw( _cell_length_a
                        _cell_length_b
                        _cell_length_c
                        _cell_angle_alpha
                        _cell_angle_beta
                        _cell_angle_gamma );
    for (0..5) {
        next if !defined $$cell[$_];
        set_tag( $datablock, $cell_tags[$_], $$cell[$_] );
    }

    set_loop_tag( $datablock,
                  '_atom_site_label',
                  '_atom_site_label',
                  [ map { $_->{name} } @$atom_list ] );
    set_loop_tag( $datablock,
                  '_atom_site_fract_x',
                  '_atom_site_label',
                  [ map { $_->{coordinates_fract}[0] } @$atom_list ] );
    set_loop_tag( $datablock,
                  '_atom_site_fract_y',
                  '_atom_site_label',
                  [ map { $_->{coordinates_fract}[1] } @$atom_list ] );
    set_loop_tag( $datablock,
                  '_atom_site_fract_z',
                  '_atom_site_label',
                  [ map { $_->{coordinates_fract}[2] } @$atom_list ] );

    print_cif( $datablock );
}

1;
