# social_media.tcl --
#     Simulate what happens if the community of some social medium is upset and
#     intends to move to another platform.
#
#     Inspired by a recent event with Whatsapp:
#     The guys behind Whatsapp introduced a new feature - two blue marks to show
#     that your message has been received and viewed. This was felt as a (further)
#     breach to one's privacy - forcing people to react immediately - and many
#     people thought of moving to some other platform.
#
#     The idea of the simulation:
#     - People are upset and want to move, but they are inclined to follow their
#       friends because connectivity is slightly more important than privacy.
#     - Each person has one or more friends - the number is determined by means
#       of a Poisson distribution. The connectivity is reciprocal (slight
#       complication in setting up the network), that is A is connected to B and
#       B is connected to A.
#     - The probability of someone wanting to change is p. They do not change
#       immediately though - that depends on how many of their friends will change
#       too.
#     - If someone does not want to change yet (after drawing a random number),
#       then the probability of intending to change is determined by the number
#       of friends that intend to change or have already changed.
#     - Now we have the intention of changing. Let them switch.
#     - Intending to change from platform A to platform B has a probability p1.
#       Intending to change from platform B to platform A has a probability p2.
#
#     Note:
#     Not sure if the implementation is correct - it seems far too dynamic!
#     There seems to be a transition at probabilities of 0.0023 or thereabouts.
#
#     I need to check the implementation, but it is more fun than I imagined.
#     Not entirely sure if the actual switching is implemented realistically.
#     Should there not be a probability factor?
#
package require math::statistics

# buildNetwork --
#     Build the network of friends
#
# Arguments:
#     nMembers         Number of members in the network
#     nFriends         Mean number of friends per person
#
# Result:
#     List of persons and their friends (each person is simply an integer)
#     The information per person: current platform (A or B), intending to
#     switch (0 or 1), list of friends
#
proc buildNetwork {nMembers nFriends} {

    #
    # Set up the number of friends per person
    #
    set nF          [::math::statistics::random-poisson $nFriends $nMembers]
    set nCheck      $nF
    for {set i 0} {$i < $nMembers} {incr i} {
        lappend remainingMembers $i
        set friendsList($i) {}
    }

    #
    # Choose the friends
    #
    # Note:
    # It may not be possible to assign enough friends to everyone. To make the
    # algorithm finish, allow members to be their own friends and remove them
    # afterwards. Also allow double connections - the algorithm may not
    # finish otherwise :(.
    #
    while { [llength $remainingMembers] > 0 } {
        foreach member $remainingMembers {
            set f [expr {int([llength $remainingMembers] * rand())}]
            set friend [lindex $remainingMembers $f]

            lappend friendsList($member) $friend
            lappend friendsList($friend) $member
            lset nF $member [expr {[lindex $nF $member] - 1}]
            lset nF $friend [expr {[lindex $nF $friend] - 1}]
        }

        #
        # Remove the members that have a complete assortment of friends
        #
        set newList {}
        foreach member $remainingMembers {
            if { [lindex $nF $member] > 0 } {
                lappend newList $member
            }
        }
        set remainingMembers $newList
    }

    #
    # Assemble the information
    #
    for {set i 0} {$i < $nMembers} {incr i} {
        set friends {}
        foreach f [lsort -unique $friendsList($i)] {
            if {$f != $i } {
                lappend friends $f
            }
        }
        lappend network [list A 0 $friends]
    }

    return $network
}

# updateIntention --
#     Update the intention to switch in two steps
#
# Arguments:
#     nameNetwork         Name of the variable holding the network
#     probFromA           Probability of intending to switch from A to B
#     probToB             Probability of intending to switch from B to A
#
proc updateIntention {nameNetwork probFromA probFromB} {
    upvar 1 $nameNetwork network

    #
    # First of all, the personal choice
    #
    #set c 0
    for {set p 0} {$p < [llength $network]} {incr p} {
        set currentChoice [lindex $network $p 0]
        if { $currentChoice == "A" } {
            set intention [expr {rand() < $probFromA}]
        } else {
            set intention [expr {rand() < $probFromB}]
        }
        lset network $p 1 $intention
        #incr c $intention
    }
    #puts "First round: $c"

    #
    # Second step, what do their friends think?
    #
    for {set p 0} {$p < [llength $network]} {incr p} {
        set currentIntention [lindex $network $p 1]
        if { ! $currentIntention } {
            set probSwitch [intentionFriends $network [lindex $network $p 0] [lindex $network $p 2]]
            set intention [expr {rand() < $probSwitch}]
            lset network $p 1 $intention
            #incr c $intention
        }
    }
    #puts "Second rount - intending to switch: $c"
}

# intentionFriends --
#     Examine the intention of their friends
#
# Arguments:
#     network           Network data
#     currentChoice     Current choice (A or B)
#     friends           List of friends
#
# Returns:
#     Fractions of friends that would change to the other choice
#
proc intentionFriends {network currentChoice friends} {
    set count 0
    foreach p $friends {
        set friendChoice    [lindex $network $p 0]
        set friendIntention [lindex $network $p 1]
        if { $friendChoice == $currentChoice && $friendIntention } {
            incr count
        }
        if { $friendChoice != $currentChoice && ! $friendIntention } {
            incr count
        }
    }

    return [expr {$count / double([llength $friends])}]
}

# switchChoice --
#     Make the people switch
#
# Arguments:
#     nameNetwork         Name of the variable holding the network
#
# Returns:
#     Fractions of friends that would change to the other choice
#
proc switchChoice {nameNetwork} {
    upvar 1 $nameNetwork network

    set count 0
    for {set p 0} {$p < [llength $network]} {incr p} {
        set choice    [lindex $network $p 0]
        set intention [lindex $network $p 1]

        if { $intention } {
            if { $choice == "A" } {
                lset network $p 0 "B"
            } else {
                lset network $p 0 "A"
            }
            lset network $p 1 0
        }
    }
}

# printStats --
#     Print the statistics
#
# Arguments:
#     network         Network data
#
# Returns:
#     Nothing - just prints the counts
#
proc printStats {network} {

    set countA 0
    for {set p 0} {$p < [llength $network]} {incr p} {
        set choice    [lindex $network $p 0]
        if { $choice == "A" } {
            incr countA
        }
    }
    puts "$countA -- [expr {[llength $network] - $countA}]"
}

# main --
#     Start the simulation
#
set network [buildNetwork 1000 10]

for {set t 0} {$t < 1000} {incr t} {
    updateIntention network 0.002 0.002
    switchChoice network
    printStats $network
}