# 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 }