1package FC_Solve::DeltaStater; 2 3use strict; 4use warnings; 5 6use Games::Solitaire::Verify::Card (); 7use Games::Solitaire::Verify::Column (); 8use Games::Solitaire::Verify::State (); 9use Games::Solitaire::Verify::VariantsMap (); 10 11use FC_Solve::DeltaStater::BitWriter; 12use FC_Solve::DeltaStater::BitReader; 13 14use parent 'Games::Solitaire::Verify::Base'; 15 16my $two_fc_variant = 17 Games::Solitaire::Verify::VariantsMap->new->get_variant_by_id('freecell'); 18 19$two_fc_variant->num_freecells(2); 20 21sub _get_two_fc_variant 22{ 23 return $two_fc_variant; 24} 25 26my $bakers_dozen_variant = 27 Games::Solitaire::Verify::VariantsMap->new->get_variant_by_id( 28 'bakers_dozen'); 29 30__PACKAGE__->mk_acc_ref( 31 [ 32 qw( 33 _derived_state _init_state _columns_initial_lens _orig_args _variant 34 ) 35 ] 36); 37 38sub _get_column_orig_num_cards 39{ 40 my ( $self, $col ) = @_; 41 42 my $num_cards = $col->len(); 43 44CALC_NUM_CARDS: 45 while ( $num_cards >= 2 ) 46 { 47 my $child_card = $col->pos( $num_cards - 1 ); 48 my $parent_card = $col->pos( $num_cards - 2 ); 49 if ( 50 !( 51 ( $child_card->rank() + 1 == $parent_card->rank() ) 52 && ( $child_card->color() ne $parent_card->color() ) 53 ) 54 ) 55 { 56 last CALC_NUM_CARDS; 57 } 58 } 59 continue 60 { 61 $num_cards--; 62 } 63 64 if ( $num_cards == 1 ) 65 { 66 $num_cards = 0; 67 } 68 69 return $num_cards; 70} 71 72sub _is_bakers_dozen 73{ 74 my ($self) = @_; 75 76 return ( $self->_variant() eq "bakers_dozen" ); 77} 78 79sub _calc_state_obj_generic 80{ 81 my ( $self, $args ) = @_; 82 return $self->_is_bakers_dozen() 83 ? Games::Solitaire::Verify::State->new( 84 { 85 variant => $self->_variant(), 86 %{$args}, 87 } 88 ) 89 : Games::Solitaire::Verify::State->new( 90 { 91 variant => 'custom', 92 variant_params => $two_fc_variant, 93 %{$args}, 94 }, 95 ); 96} 97 98sub _calc_state_obj_from_string 99{ 100 my ( $self, $args ) = @_; 101 102 return $self->_calc_state_obj_generic( 103 { string => $args->{str}, %$args, } ); 104} 105 106sub _calc_new_empty_state_obj 107{ 108 my ($self) = @_; 109 110 return $self->_calc_state_obj_generic( { %{ $self->_orig_args() }, } ); 111} 112 113sub _init 114{ 115 my ( $self, $args ) = @_; 116 117 $self->_orig_args($args); 118 119 $self->_variant( $args->{variant} || "two_fc_freecell" ); 120 121 $self->_init_state( 122 $self->_calc_state_obj_from_string( 123 { str => $args->{init_state_str}, %$args, } 124 ) 125 ); 126 127 my $init_state = $self->_init_state; 128 129 my @columns_initial_bit_lens; 130 131 foreach my $col_idx ( 0 .. $init_state->num_columns() - 1 ) 132 { 133 my $num_cards = 134 $self->_get_column_orig_num_cards( 135 $init_state->get_column($col_idx) ); 136 137 my $bitmask = 1; 138 my $num_bits = 0; 139 140 while ( $bitmask <= $num_cards ) 141 { 142 ++$num_bits; 143 $bitmask <<= 1; 144 } 145 146 push @columns_initial_bit_lens, $num_bits; 147 } 148 149 $self->_columns_initial_lens( \@columns_initial_bit_lens ); 150 151 return; 152} 153 154sub set_derived 155{ 156 my ( $self, $args ) = @_; 157 158 $self->_derived_state( 159 $self->_calc_state_obj_from_string( 160 { str => $args->{state_str}, %$args, } 161 ) 162 ); 163 164 return; 165} 166 167my @suits = (qw(H C D S)); 168 169# NOTE : Not used because it can be calculated from the freecells and the 170# columns. 171sub get_foundations_bits 172{ 173 my ($self) = @_; 174 175 return [ 176 map { [ 4 => $self->_derived_state->get_foundation_value( $_, 0 ) ] } 177 @suits ]; 178} 179 180sub _get_suit_bit 181{ 182 my ( $self, $card ) = @_; 183 184 my $suit = $card->suit(); 185 186 return ( ( $suit eq 'H' || $suit eq 'C' ) ? 0 : 1 ); 187} 188 189my %suit_to_idx = do 190{ 191 my $s = Games::Solitaire::Verify::Card->get_suits_seq(); 192 ( map { $s->[$_] => $_ } ( 0 .. $#$s ) ); 193}; 194 195sub _suit_get_suit_idx 196{ 197 my ( $self, $suit ) = @_; 198 199 return $suit_to_idx{$suit}; 200} 201 202sub _get_suit_idx 203{ 204 my ( $self, $card ) = @_; 205 206 return $self->_suit_get_suit_idx( $card->suit ); 207} 208 209sub _get_card_bitmask 210{ 211 my ( $self, $card ) = @_; 212 213 return ( $self->_get_suit_idx($card) | ( $card->rank() << 2 ) ); 214} 215 216sub _calc_card 217{ 218 my ( $self, $rank, $suit_idx ) = @_; 219 220 return Games::Solitaire::Verify::Card->new( 221 { 222 string => ( 223 Games::Solitaire::Verify::Card->rank_to_string($rank) 224 . $suits[$suit_idx] 225 ) 226 } 227 ); 228} 229 230my $COL_TYPE_EMPTY = 0; 231my $COL_TYPE_ENTIRELY_NON_ORIG = 1; 232my $COL_TYPE_HAS_ORIG = 2; 233 234sub _get_column_encoding_composite 235{ 236 my ( $self, $col_idx ) = @_; 237 238 my $derived = $self->_derived_state(); 239 240 my $col = $derived->get_column($col_idx); 241 242 my $num_orig_cards = $self->_get_column_orig_num_cards($col); 243 244 my $col_len = $col->len(); 245 my $num_derived_cards = $col_len - $num_orig_cards; 246 247 my $num_cards_in_seq = $num_derived_cards; 248 my @init_card; 249 if ( ( $num_orig_cards == 0 ) && $num_derived_cards ) 250 { 251 @init_card = ( [ 6 => $self->_get_card_bitmask( $col->pos(0) ) ] ); 252 $num_cards_in_seq--; 253 } 254 255 return { 256 type => ( 257 ( $col_len == 0 ) ? $COL_TYPE_EMPTY 258 : $num_orig_cards ? $COL_TYPE_HAS_ORIG 259 : $COL_TYPE_ENTIRELY_NON_ORIG 260 ), 261 enc => [ 262 [ $self->_columns_initial_lens->[$col_idx] => $num_orig_cards ], 263 [ 4 => $num_derived_cards ], 264 @init_card, 265 ( 266 map { [ 1 => $self->_get_suit_bit( $col->pos($_) ) ] } 267 ( $col_len - $num_cards_in_seq .. $col_len - 1 ) 268 ), 269 ], 270 }; 271} 272 273sub get_column_encoding 274{ 275 my ( $self, $col_idx ) = @_; 276 277 return $self->_get_column_encoding_composite($col_idx)->{enc}; 278} 279 280sub get_freecells_encoding 281{ 282 my ($self) = @_; 283 284 my $derived = $self->_derived_state(); 285 286 return [ 287 map { 288 my $card = $derived->get_freecell($_); 289 [ 6 => ( defined($card) ? $self->_get_card_bitmask($card) : 0 ) ] 290 } ( 0 .. $derived->num_freecells() - 1 ) 291 ]; 292} 293 294sub _composite_get_cols_and_indexes 295{ 296 my ($self) = @_; 297 298 my @cols_indexes = ( 0 .. $self->_derived_state->num_columns - 1 ); 299 my @cols = 300 ( map { $self->_get_column_encoding_composite($_) } @cols_indexes ); 301 302 { 303 my $non_orig_idx = 0; 304 my $empty_idx = $#cols; 305 306 # Move the empty columns to the front, but only within the 307 # entirely_non_orig 308 # That's because the orig columns should be preserved in their own 309 # place. 310 MOVE_EMPTIES_LOOP: 311 while (1) 312 { 313 NON_ORIG_IDX_LOOP: 314 while ( $non_orig_idx < @cols ) 315 { 316 if ( $cols[$non_orig_idx]->{type} eq 317 $COL_TYPE_ENTIRELY_NON_ORIG ) 318 { 319 last NON_ORIG_IDX_LOOP; 320 } 321 } 322 continue 323 { 324 ++$non_orig_idx; 325 } 326 327 if ( $non_orig_idx == @cols ) 328 { 329 last MOVE_EMPTIES_LOOP; 330 } 331 332 EMPTY_IDX_LOOP: 333 while ( $empty_idx >= 0 ) 334 { 335 if ( $cols[$empty_idx]->{type} eq $COL_TYPE_EMPTY ) 336 { 337 last EMPTY_IDX_LOOP; 338 } 339 } 340 continue 341 { 342 --$empty_idx; 343 } 344 345 if ( ( $empty_idx < 0 ) || ( $empty_idx < $non_orig_idx ) ) 346 { 347 last MOVE_EMPTIES_LOOP; 348 } 349 350 @cols_indexes[ $non_orig_idx, $empty_idx ] = 351 @cols_indexes[ $empty_idx, $non_orig_idx ]; 352 ++$non_orig_idx; 353 --$empty_idx; 354 } 355 } 356 357 { 358 my @new_non_orig_cols_indexes = 359 ( grep { $cols[$_]->{type} eq $COL_TYPE_ENTIRELY_NON_ORIG } 360 @cols_indexes ); 361 362 my $get_sort_val = sub { 363 my ($i) = @_; 364 return $self->_get_card_bitmask( 365 $self->_derived_state()->get_column($i)->pos(0) ); 366 }; 367 my @sorted = ( sort { $get_sort_val->($a) <=> $get_sort_val->($b) } 368 @new_non_orig_cols_indexes ); 369 370 foreach my $idx_idx ( 0 .. $#cols_indexes ) 371 { 372 if ( $cols[ $cols_indexes[$idx_idx] ]->{type} eq 373 $COL_TYPE_ENTIRELY_NON_ORIG ) 374 { 375 $cols_indexes[$idx_idx] = shift(@sorted); 376 } 377 } 378 } 379 380 return { cols => \@cols, cols_indexes => \@cols_indexes }; 381} 382 383sub encode_composite 384{ 385 my ($self) = @_; 386 387 my $cols_struct = $self->_composite_get_cols_and_indexes; 388 389 my $cols = $cols_struct->{cols}; 390 my $cols_indexes = $cols_struct->{cols_indexes}; 391 392 my $bit_writer = FC_Solve::DeltaStater::BitWriter->new; 393 foreach my $bit_spec ( 394 @{ $self->get_freecells_encoding() }, 395 ( map { @{ $_->{enc} } } @{$cols}[ @{$cols_indexes} ] ), 396 ) 397 { 398 $bit_writer->write( $bit_spec->[0] => $bit_spec->[1] ); 399 } 400 401 return $bit_writer->get_bits(); 402} 403 404sub encode 405{ 406 my ($self) = @_; 407 408 my $bit_writer = FC_Solve::DeltaStater::BitWriter->new; 409 410 foreach my $bit_spec ( 411 @{ $self->get_freecells_encoding() }, 412 ( 413 map { @{ $self->get_column_encoding($_) } } 414 ( 0 .. $self->_derived_state->num_columns - 1 ) 415 ), 416 ) 417 { 418 $bit_writer->write( $bit_spec->[0] => $bit_spec->[1] ); 419 } 420 421 return $bit_writer->get_bits(); 422} 423 424sub decode 425{ 426 my ( $self, $bits ) = @_; 427 428 my $bit_reader = FC_Solve::DeltaStater::BitReader->new( { bits => $bits } ); 429 430 my %foundations = ( map { $_ => 14 } @suits ); 431 432 my $process_card = sub { 433 my $card = shift; 434 435 if ( $card->rank() < $foundations{ $card->suit() } ) 436 { 437 $foundations{ $card->suit() } = $card->rank(); 438 } 439 440 return $card; 441 }; 442 443 my $process_card_bits = sub { 444 my $card_bits = shift; 445 446 my $card = $self->_calc_card( 447 ( $card_bits >> 2 ), 448 ( $card_bits & ( ( 1 << 2 ) - 1 ) ), 449 ); 450 451 return $process_card->($card); 452 }; 453 454 my $num_freecells = $self->_init_state->num_freecells(); 455 456 # Read the Freecells. 457 my $freecells = 458 Games::Solitaire::Verify::Freecells->new( { count => $num_freecells } ); 459 460 foreach my $freecell_idx ( 0 .. $num_freecells - 1 ) 461 { 462 my $card_bits = $bit_reader->read(6); 463 464 if ( $card_bits != 0 ) 465 { 466 $freecells->assign( $freecell_idx, 467 $process_card_bits->($card_bits) ); 468 } 469 } 470 471 my @columns; 472 473 foreach my $col_idx ( 0 .. $self->_init_state->num_columns - 1 ) 474 { 475 my $col = Games::Solitaire::Verify::Column->new( { cards => [] } ); 476 477 my $num_orig_cards = 478 $bit_reader->read( $self->_columns_initial_lens->[$col_idx] ); 479 480 my $orig_col = $self->_init_state->get_column($col_idx); 481 foreach my $i ( 0 .. $num_orig_cards - 1 ) 482 { 483 $col->push( $process_card->( $orig_col->pos($i)->clone() ), ); 484 } 485 486 my $num_derived_cards = $bit_reader->read(4); 487 my $num_cards_in_seq = $num_derived_cards; 488 489 if ( ( $num_orig_cards == 0 ) && $num_derived_cards ) 490 { 491 my $card_bits = $bit_reader->read(6); 492 $col->push( $process_card_bits->($card_bits) ); 493 $num_cards_in_seq--; 494 } 495 496 if ($num_cards_in_seq) 497 { 498 my $last_card = $col->pos(-1); 499 for my $i ( 0 .. $num_cards_in_seq - 1 ) 500 { 501 my $suit_bit = $bit_reader->read(1); 502 503 my $new_card = $self->_calc_card( 504 ( $last_card->rank() - 1 ), 505 ( 506 ( $suit_bit << 1 ) | 507 ( $last_card->color eq "red" ? 1 : 0 ) 508 ), 509 ); 510 511 $col->push( $process_card->( $last_card = $new_card ) ); 512 } 513 } 514 515 push @columns, $col; 516 } 517 518 my $foundations_obj = Games::Solitaire::Verify::Foundations->new( 519 { 520 num_decks => 1, 521 }, 522 ); 523 524 foreach my $found ( keys(%foundations) ) 525 { 526 $foundations_obj->assign( $found, 0, $foundations{$found} - 1 ); 527 } 528 529 my $state = $self->_calc_new_empty_state_obj(); 530 foreach my $col (@columns) 531 { 532 $state->add_column($col); 533 } 534 $state->set_freecells($freecells); 535 $state->set_foundations($foundations_obj); 536 537 return $state; 538} 539 5401; 541 542__END__ 543 544=head1 COPYRIGHT AND LICENSE 545 546This file is part of Freecell Solver. It is subject to the license terms in 547the COPYING.txt file found in the top-level directory of this distribution 548and at http://fc-solve.shlomifish.org/docs/distro/COPYING.html . No part of 549Freecell Solver, including this file, may be copied, modified, propagated, 550or distributed except according to the terms contained in the COPYING file. 551 552Copyright (c) 2009 Shlomi Fish 553 554=cut 555