Paste: minconflicts

Author:	zbrown
Mode:	factor
Date:	Sun, 8 Nov 2009 23:39:30

Plain Text |

Delete Paste

! Author      : Zac Brown
! Date        : 11.01.2009
! Filename    : minconflicts.factor
! Description : Implementation of MinConflicts on 10 Southeastern
!               United States states.

USING: kernel math strings arrays hashtables assocs sequences accessors locals
namespaces io random combinators sorting math.order system ;
IN: minconflicts

! state data information
TUPLE: state
{ stateName string read-only }
{ stateNeighbors array read-only } ;

: <state> ( string array -- state )
    state boa ;

SYMBOLS: seCSP assignment selectedVar ;


! //////////////////////////////////////////////////////////////////////////////
! min conflicts implementation
! //////////////////////////////////////////////////////////////////////////////

<PRIVATE

! arguments: state color
: setStateColor ( string string -- ) assignment get set-at ; inline

: getStateColor ( string -- string ) assignment get at* drop ; inline

! arguments: state color
: hasConflict ( string string -- ? )
    swap getStateColor = ; inline

: checkConflictNeighbors ( state -- ? )
    dup stateName>> swap stateNeighbors>> swap getStateColor
    [| neighbors col | neighbors [ col hasConflict ] map ] call
    [ f = ] all? not ; inline

: checkAssignment ( -- ? )
    seCSP get [ checkConflictNeighbors ] map [ t = ] all? ; inline

: getColorFromInt ( int -- string )
    {
        { [ dup 0 = ] [ "RED" ] }
        { [ dup 1 = ] [ "BLUE" ] }
        { [ dup 2 = ] [ "GREEN" ] }
        { [ dup 3 = ] [ "PURPLE" ] }
    } cond swap drop ; inline

: generateRandomAssignment ( -- )
    seCSP get
    [| csp |
        csp [ stateName>> ] map
        [ 4 random getColorFromInt swap setStateColor ] each
    ] call ; inline

: selectConflictVariable ( -- state )
    seCSP get
    [| csp |
        csp length random selectedVar set
        [ selectedVar get csp nth checkConflictNeighbors f = ]
        [ csp length random selectedVar set ]
        while
        selectedVar get csp nth
    ] call ; inline

: checkConflictColors ( string array -- int )
    [| color neighbors |
        neighbors [ getStateColor color = ] map
        [ t = ] filter length
    ] call ; inline

! arguments: state, return color
: selectMinConflictValue ( state -- string )
    dup stateName>> print
    stateNeighbors>>
    [| neighbors |
        { 0 1 2 3 } dup [ getColorFromInt neighbors checkConflictColors ] map
        [ 2array ] 2map
        [ [ second ] bi@ <=> ] sort dup print
        first first getColorFromInt
    ] call ; inline

PRIVATE>

SYMBOLS: iterations count ;

: minConflicts ( int -- )
    iterations set
    0 count set
    generateRandomAssignment
    [ count get iterations get < ]
    [
        checkAssignment
        [ 1000000 count set ]
        [
            selectConflictVariable dup
            selectMinConflictValue swap
            stateName>>
            setStateColor
            1 count get + count set
        ]
        if
    ]
    while ; inline

: runMinConflicts ( -- )
    {
        T{ state { stateName "NC" } { stateNeighbors { "VA" "TN" "SC" "GA" } } }
        T{ state { stateName "VA" } { stateNeighbors { "NC" "TN" "KY" "WV" } } }
        T{ state { stateName "WV" } { stateNeighbors { "VA" "KY" } } }
        T{ state { stateName "TN" } { stateNeighbors { "KY" "NC" "VA" "MS" "AL" "GA" } } }
        T{ state { stateName "MS" } { stateNeighbors { "TN" "AL" } } }
        T{ state { stateName "AL" } { stateNeighbors { "MS" "GA" "FL" "TN" } } }
        T{ state { stateName "GA" } { stateNeighbors { "AL" "FL" "SC" "TN" "NC" } } }
        T{ state { stateName "FL" } { stateNeighbors { "AL" "GA" } } }
        T{ state { stateName "SC" } { stateNeighbors { "GA" "NC" } } }
        T{ state { stateName "KY" } { stateNeighbors { "TN" "VA" "WV" } } }
    } seCSP set

    H{
        { "NC" "none" }
        { "VA" "none" }
        { "WV" "none" }
        { "TN" "none" }
        { "MS" "none" }
        { "AL" "none" }
        { "GA" "none" }
        { "FL" "none" }
        { "SC" "none" }
        { "KY" "none" }
    } assignment set
    10 minConflicts assignment get print ; inline

MAIN: runMinConflicts
! runMinConflicts

Annotation: update

Author:	zbrown
Mode:	factor
Date:	Mon, 9 Nov 2009 00:32:07

Plain Text |

Delete Annotation

USING: kernel math strings arrays hashtables assocs sequences accessors locals
namespaces io random combinators sorting math.order system prettyprint ;
IN: minconflicts

! state data information
TUPLE: state
{ stateName string read-only }
{ stateNeighbors array read-only } ;

: <state> ( string array -- state )
    state boa ;

SYMBOLS: seCSP assignment selectedVar ;


! //////////////////////////////////////////////////////////////////////////////
! min conflicts implementation
! //////////////////////////////////////////////////////////////////////////////

<PRIVATE

! arguments: state color
: setStateColor ( string string -- ) assignment get set-at ;

: getStateColor ( string -- string ) assignment get at* drop ;

! arguments: state color
: hasConflict ( string string -- ? )
    swap getStateColor = ;

: checkConflictNeighbors ( state -- ? )
    dup stateName>> swap stateNeighbors>> swap getStateColor
    [| neighbors col | neighbors [ col hasConflict ] map ] call
    [ f = ] all? not ;

: checkAssignment ( -- ? )
    seCSP get [ checkConflictNeighbors ] map [ t = ] all? ;

: getColorFromInt ( int -- string )
    ! {
    !     { [ dup 0 = ] [ "RED" ] }
    !     { [ dup 1 = ] [ "BLUE" ] }
    !     { [ dup 2 = ] [ "GREEN" ] }
    !     { [ dup 3 = ] [ "PURPLE" ] }
    ! } cond swap drop
    H{ { 0 "RED" }
       { 1 "BLUE" }
       { 2 "GREEN" }
       { 3 "PURPLE" } } at ;

: generateRandomAssignment ( -- )
    seCSP get
    [| csp |
        csp [ stateName>> ] map
        [ 4 random getColorFromInt swap setStateColor ] each
    ] call ;

: selectConflictVariable ( -- state )
    seCSP get
    [| csp |
        csp length random selectedVar set
        [ selectedVar get csp nth checkConflictNeighbors f = ]
        [ csp length random selectedVar set ]
        while
        selectedVar get csp nth
    ] call ;

: checkConflictColors ( string array -- int )
    [| color neighbors |
        neighbors [ getStateColor color = ] map
        [ t = ] filter length
    ] call ;

! arguments: state, return color
: selectMinConflictValue ( state -- string )
    ! dup stateName>> print
    stateNeighbors>>
    [| neighbors |
        { 0 1 2 3 } dup [ getColorFromInt neighbors checkConflictColors ] map
        [ 2array ] 2map
        [ [ second ] bi@ <=> ] sort
        first first getColorFromInt
    ] call ;

PRIVATE>

SYMBOLS: iterations count ;

: minConflicts ( int -- )
    "roflcopter!" print
    iterations set
    0 count set
    generateRandomAssignment
    [ count get iterations get < ]
    [
        checkAssignment
        [ 1000000 count set ]
        [
            selectConflictVariable dup
            selectMinConflictValue swap
            stateName>>
            setStateColor
            1 count get + count set
        ]
        if
    ]
    while ;

: runMinConflicts ( -- )
    {
        T{ state { stateName "NC" } { stateNeighbors { "VA" "TN" "SC" "GA" } } }
        T{ state { stateName "VA" } { stateNeighbors { "NC" "TN" "KY" "WV" } } }
        T{ state { stateName "WV" } { stateNeighbors { "VA" "KY" } } }
        T{ state { stateName "TN" } { stateNeighbors { "KY" "NC" "VA" "MS" "AL" "GA" } } }
        T{ state { stateName "MS" } { stateNeighbors { "TN" "AL" } } }
        T{ state { stateName "AL" } { stateNeighbors { "MS" "GA" "FL" "TN" } } }
        T{ state { stateName "GA" } { stateNeighbors { "AL" "FL" "SC" "TN" "NC" } } }
        T{ state { stateName "FL" } { stateNeighbors { "AL" "GA" } } }
        T{ state { stateName "SC" } { stateNeighbors { "GA" "NC" } } }
        T{ state { stateName "KY" } { stateNeighbors { "TN" "VA" "WV" } } }
    } seCSP set

    H{
        { "NC" "none" }
        { "VA" "none" }
        { "WV" "none" }
        { "TN" "none" }
        { "MS" "none" }
        { "AL" "none" }
        { "GA" "none" }
        { "FL" "none" }
        { "SC" "none" }
        { "KY" "none" }
    } assignment set
    150 minConflicts assignment get . ;

MAIN: runMinConflicts
runMinConflicts

Annotation: newest version

Author:	zbrown
Mode:	factor
Date:	Mon, 9 Nov 2009 01:47:13

Plain Text |

Delete Annotation

USING: kernel math strings arrays hashtables assocs sequences accessors locals
namespaces random combinators sorting math.order system prettyprint
io.launcher.unix io ;
IN: minconflicts

! state data information
TUPLE: state
{ stateName string read-only }
{ stateNeighbors array read-only } ;

: <state> ( string array -- state )
    state boa ;

SYMBOLS: seCSP assignment selectedVar ;


! //////////////////////////////////////////////////////////////////////////////
! min conflicts implementation
! //////////////////////////////////////////////////////////////////////////////

<PRIVATE

! arguments: state color
: setStateColor ( string string -- ) assignment get set-at ;

: getStateColor ( string -- string ) assignment get at* drop ;

! arguments: state color
: hasConflict ( string string -- ? )
    swap getStateColor = ;

: checkConflictNeighbors ( state -- ? )
    dup stateName>> swap stateNeighbors>> swap getStateColor
    [| neighbors col | neighbors [ col hasConflict ] map ] call
    [ f = ] all? not ;

: checkAssignment ( -- ? )
    seCSP get [ checkConflictNeighbors ] map [ f = ] all? ;

: getColorFromInt ( int -- string )
    H{ { 0 "RED" }
       { 1 "BLUE" }
       { 2 "GREEN" }
       { 3 "PURPLE" } } at ;

: generateRandomAssignment ( -- )
    seCSP get
    [| csp |
        csp [ stateName>> ] map
        [ 4 random getColorFromInt swap setStateColor ] each
    ] call ;

: selectConflictVariable ( -- state )
    seCSP get
    [| csp |
        csp length random selectedVar set
        [ selectedVar get csp nth checkConflictNeighbors f = ]
        [ csp length random selectedVar set ]
        while
        selectedVar get csp nth
    ] call ;

: checkConflictColors ( string array -- int )
    [| color neighbors |
        neighbors [ getStateColor color = ] map
        [ t = ] filter length
    ] call ;

! arguments: state, return color
: selectMinConflictValue ( state -- string )
    stateNeighbors>>
    [| neighbors |
        { 0 1 2 3 } dup [ getColorFromInt neighbors checkConflictColors ] map
        [ 2array ] 2map
        [ [ second ] bi@ <=> ] sort
        first first getColorFromInt
    ] call ;

PRIVATE>

SYMBOLS: iterations count ;

: minConflicts ( int -- )
    iterations set
    0 count set
    generateRandomAssignment
    [ count get iterations get < ]
    [
        checkAssignment
        [
            iterations get count get + count set
        ]
        [
            selectConflictVariable dup
            selectMinConflictValue swap
            stateName>>
            setStateColor
            1 count get + count set
        ]
        if
    ]
    while

    checkAssignment
    [ "SUCCESS: " print assignment get . ]
    [ "FAILURE." print ]
    if flush ;

: runMinConflicts ( -- )
    {
        T{ state { stateName "NC" } { stateNeighbors { "VA" "TN" "SC" "GA" } } }
        T{ state { stateName "VA" } { stateNeighbors { "NC" "TN" "KY" "WV" } } }
        T{ state { stateName "WV" } { stateNeighbors { "VA" "KY" } } }
        T{ state { stateName "TN" } { stateNeighbors { "KY" "NC" "VA" "MS" "AL" "GA" } } }
        T{ state { stateName "MS" } { stateNeighbors { "TN" "AL" } } }
        T{ state { stateName "AL" } { stateNeighbors { "MS" "GA" "FL" "TN" } } }
        T{ state { stateName "GA" } { stateNeighbors { "AL" "FL" "SC" "TN" "NC" } } }
        T{ state { stateName "FL" } { stateNeighbors { "AL" "GA" } } }
        T{ state { stateName "SC" } { stateNeighbors { "GA" "NC" } } }
        T{ state { stateName "KY" } { stateNeighbors { "TN" "VA" "WV" } } }
    } seCSP set

    H{
        { "NC" "none" }
        { "VA" "none" }
        { "WV" "none" }
        { "TN" "none" }
        { "MS" "none" }
        { "AL" "none" }
        { "GA" "none" }
        { "FL" "none" }
        { "SC" "none" }
        { "KY" "none" }
    } assignment set
    1000 minConflicts ;

MAIN: runMinConflicts

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done